PDA

View Full Version : for loops in vba ?



BaxterStockm
03-03-2011, 01:46 PM
hey

is there some kind of a for loop in vba like in java.

i want to programm a method that looks in every cell and changes the number in it to red when the value is below 0
and acutally i want this method to end until one which has no date

in my excel sheet there is a date column, two hours column and the differenz column. The value of the Differenz column is made by combining both hours columns - 8

this is my code




' Apply the formula to the cell range
Range("G2").Select
ActiveCell.FormulaR1C1 = "=RC[-2]+RC[-1]-8"
Selection.AutoFill Destination:=ActiveCell.Range("A1:A10"), Type:=xlFillDefault
' Apply the color depending on results
' Loop through each cell, do the comparison and apply the color
Range("G2").Select
If ActiveCell.Value < 0 Then
ActiveCell.Font.Color = -16776961
ActiveCell.Font.TintAndShade = 0
Else
ActiveCell.Font.Color = xlThemeColorLight1
ActiveCell.Font.TintAndShade = 0
End If
End Sub



so how do i create a loop in vba, usually in java i would create a for loop with (int i =0;i<10;i++) or a while loop with (...=="") or something like

i tried to do it with do loop unitl Range("A55").value= ???
first of all what should i put in the spot where the question marks are
and second how do i do that it keeps on selecting the next Cell instead of staying in one cell.

Blade Hunter
03-03-2011, 03:12 PM
There are a number of ways you can do this.

1)
For X = 1 to range("A" & rows.count).end(xlup).row
'Your code here where X is the row you are on (Reference with Range("A" & X).something)
Next

2)
For each cell in range("A" & Range("A" & Rows.count).end(xlup).row)
'Your code here, cell is the cell you are working on (Reference with cell.something)
Next
3)
Do while IsDate(Range("A" & X))
'Your code here where X is the row you are on (Reference with Range("A" & X).something)
X = X + 1
loop

My personal preference is for each cell in blah blah blah but each has their own benefit at certain times.

From your initial post, it looks like you just wanted some hints to figure this out, if you want more help or a complete code solution please let me know and I will put more information in for you.

Cheers

Dan

BaxterStockm
03-03-2011, 03:37 PM
hai,

thanks yeah that works but i didn't understand the third solution with the until date loop.

i'm trying to let the loop end as soon as there is no date typed in the date column



Sub Button2_Click()


' Apply the formula to the cell range

Range("G2").Select
ActiveCell.Font.Color = xlThemeColorLight1
ActiveCell.Font.TintAndShade = 0
ActiveCell.FormulaR1C1 = "=RC[-2]+RC[-1]-8"
Selection.AutoFill Destination:=ActiveCell.Range("A1:A10"), Type:=xlFillDefault
' Apply the color depending on results
' Loop through each cell, do the comparison and apply the color

Do While IsDate(Range("G" & X))

If Range("G" & X).Value < 0 Then
Range("G" & X).Font.Color = -16776961
Range("G" & X).Font.TintAndShade = 0
Else
Range("G" & X).Font.Color = xlThemeColorLight1
Range("G" & X).Font.TintAndShade = 0
End If
X = X + 1
Loop

End Sub

Blade Hunter
03-03-2011, 03:47 PM
So it will continue to loop the code until it comes to a cell that doesn't have a date in it, I do however see a problem here:

Do While IsDate(Range("G" & X))

If Range("G" & X).Value < 0 Then

You are testing "G" & X for a date then you are testing if it is < 0, it can never be < 0 if it is a date. Is it definately Column G you want to test?

BaxterStockm
03-03-2011, 03:54 PM
no, sorry i send you the wrong code, so i'll try to create a new one

BaxterStockm
03-03-2011, 04:34 PM
hey,

i'm sorry i can't concentrate on that date thing any more, but i got another question. The Dates are from one date till another including saturday and sunday. what if i want to set a new formula for these days. i tried



Sub Button2_Click()

' Apply the formula to the cell range

Range("G2").Select
ActiveCell.Font.Color = xlThemeColorLight1
ActiveCell.Font.TintAndShade = 0
ActiveCell.FormulaR1C1 = "=RC[-2]+RC[-1]-8"
Selection.AutoFill Destination:=ActiveCell.Range("A1:A10"), Type:=xlFillDefault

For x = 1 To Range("G" & Rows.Count).End(xlUp).Row

If Range("G" & x).Value < 0 Then
Range("G" & x).Font.Color = -16776961
Range("G" & x).Font.TintAndShade = 0
Else
Range("G" & x).Font.Color = xlThemeColorLight1
Range("G" & x).Font.TintAndShade = 0
End If
'next if block where i tried to catch the sunday
If Range("A:A").Value = "2/26/2011" Then
ActiveCell.FormulaR1C1 = "=RC[-2]+RC[-1]"
Else
ActiveCell.FormulaR1C1 = "=RC[-2]+RC[-1]"
End If
Next
Range("H2").Select
Range("H2").Value = Range("G2")
Range("H3").Select
ActiveCell.FormulaR1C1 = "=RC[-1]+R[-1]C"
Selection.AutoFill Destination:=ActiveCell.Range("A1:A9"), Type:= _
xlFillDefault

End Sub


and is there a possibilty that excel recognizes the weekends automatically or do i have to take them out manuell

BaxterStockm
03-03-2011, 04:41 PM
oh i think a got the last question by inserting a new column with weekdays

BaxterStockm
03-03-2011, 05:46 PM
so i got this fency code now


Sub Button2_Click()
Dim sat As Range
Dim sun As Range

'Checking and recolouring the weekdays
Range("I2").Select
For Each sat In Range("I:I")

If sat.Value = "Sunday" Then
sat.Font.Color = -11489280
sat.Font.TintAndShade = 0
sat.Activate
ActiveCell.Offset(0, -2).Activate
ActiveCell.FormulaR1C1 = "=RC[-2]+RC[-1]"
End If


Next sat

For Each sun In Range("I:I")

If sun.Value = "Saturday" Then
sun.Font.Color = -11489280
sun.Font.TintAndShade = 0
sat.Activate
ActiveCell.Offset(0, -2).Activate
ActiveCell.FormulaR1C1 = "=RC[-2]+RC[-1]"
End If
Next sun

' Apply the formula to the cell range
Range("G2").Select
ActiveCell.Font.Color = xlThemeColorLight1
ActiveCell.Font.TintAndShade = 0
ActiveCell.FormulaR1C1 = "=RC[-2]+RC[-1]-8"
Selection.AutoFill Destination:=ActiveCell.Range("A1:A10"), Type:=xlFillDefault
' Apply the color depending on results
' Loop through each cell, do the comparison and apply the color

For x = 1 To Range("G" & Rows.Count).End(xlUp).Row

If Range("G" & x).Value < 0 Then
Range("G" & x).Font.Color = -16776961
Range("G" & x).Font.TintAndShade = 0
Else
Range("G" & x).Font.Color = xlThemeColorLight1
Range("G" & x).Font.TintAndShade = 0
End If
Next


so is it possible to set the first 2 loops private so that another loop can't change the formula, cause what i does, it sets the right formula but then change it into the other formula with the '-8' what i do not want

Bob Phillips
03-04-2011, 01:42 AM
Protect the worksheet, and allow this code to unprotect it then reprotect it.

BaxterStockm
03-04-2011, 10:10 AM
ok thanks for the tip, but can i protect a single cell instead of the whole sheet cause i got the problem that the other code can do nothing in my sheet again

Range("I2").Select
For Each sat In Range("I:I")

If sat.Value = "Sunday" Then
ActiveSheet.Protect Contents:=False
sat.Select
sat.Activate
Selection.Locked = False
sat.Font.Color = -11489280
sat.Font.TintAndShade = 0
sat.Activate
ActiveCell.Offset(0, -2).Activate
ActiveCell.FormulaR1C1 = "=RC[-2]+RC[-1]"
Selection.Locked = True
ActiveSheet.Protect Contents:=True
End If

Next sat


so i tried it with activecell.protect contents:=true /false or selection.protect or something like that but there is no code like this

Bob Phillips
03-04-2011, 12:44 PM
No, it has to be the whole sheet. You can set the protection of single cells as well as the sheet which allows them to be changed, but your users can change those as well.

BaxterStockm
03-04-2011, 12:52 PM
i didn't understand that

if i protect the whole sheet in the first loop, the whole sheet is protected, so the formula-part can do nothing

anyways, what does the lock option does, if i lock a cell it still can be changed by the user or a loop or code

Bob Phillips
03-04-2011, 12:57 PM
No, I didn't explain clearly enough.

There are two levels of protection, cell protection (locking) and sheet protection. Cell protection is irrelevant is the sheet is not protected, it does nothing.

You can have some cells that are locked and some not locked. The cells that are locked, when the sheet is protected, are not user amendable. The cells that are not locked are user amendable, whether the sheet is protected or not.

BaxterStockm
03-04-2011, 01:40 PM
ok, i see but if i do that the code is still unable to act

'unlocking cells for the user
Cells.Select
Selection.Locked = False
Selection.FormulaHidden = False
'Protecting the whole sheet
ActiveSheet.Protect Contents:=True

'calculating the hours from start and endtimes
Range("B2").Select
Selection.NumberFormat = "0.00"

and i get an error in the last line because he can't wirte in that cell, but i did unlock the cells ???

Bob Phillips
03-04-2011, 03:59 PM
'unlocking cells for the user
With Cells
.Locked = False
.FormulaHidden = False
End With

'calculating the hours from start and endtimes
Range("B2").NumberFormat = "0.00"
'Protecting the whole sheet
ActiveSheet.Protect Contents:=True

BaxterStockm
03-04-2011, 04:28 PM
ok, but now i got the same problem again it's the question of where to put that code

Sub Button2_Click()
Dim sat As Range
Dim sun As Range
Dim zeitraum As Range
Sheets("Diagramm").Select
ActiveWindow.SelectedSheets.Delete
Sheets("Tabelle1").Select

Set zeitraum = Range("E2:E23")

'unlocking cells for the user
with Cells
.Locked = False
.FormulaHidden = False

'calculating the hours from start and endtimes
Range("B2").Select
Selection.NumberFormat = "0.00"
ActiveCell.Offset(0, 1).Activate
Selection.NumberFormat = "0.00"
Selection.NumberFormat = "[$-F400]h:mm:ss AM/PM"
ActiveCell.Offset(0, -1).Activate
Selection.NumberFormat = "[$-F400]h:mm:ss AM/PM"
ActiveCell.Offset(0, 3).Activate
ActiveCell.FormulaR1C1 = "=(RC[-2]-RC[-3])*24"
Selection.AutoFill Destination:=zeitraum, Type:=xlFillDefault

'Posting the weekdays
Range("I2").Select
Selection.AutoFill Destination:=Range("I2:I23"), Type:=xlFillDefault

'checking the weekdays an colouring sats and suns into green
For Each sat In Range("I:I")

If sat.Value = "Sunday" Then

' ActiveSheet.Protect Contents:=True
sat.Select
sat.Activate
Selection.Locked = False
sat.Font.Color = -11489280
sat.Font.TintAndShade = 0
sat.Activate
ActiveCell.Offset(0, -2).Activate
ActiveCell.Offset(0, -2).Activate
ActiveCell.FormulaR1C1 = "=RC[-2]+RC[-1]"
Selection.Locked = True
' ActiveSheet.Protect Contents:=True
End If

Next sat

For Each sun In Range("I:I")

If sun.Value = "Saturday" Then
' ActiveSheet.Protect Contents:=False
sun.Select
sun.Activate
Selection.Locked = False
sun.Font.Color = -11489280
sun.Font.TintAndShade = 0
sun.Activate
ActiveCell.Offset(0, -2).Activate
ActiveCell.FormulaR1C1 = "=RC[-2]+RC[-1]"
Selection.Locked = True
' ActiveSheet.Protect Contents:=True
End If
Next sun

' Apply the formula to the cell range
Range("G2").Select
ActiveCell.Font.Color = xlThemeColorLight1
ActiveCell.Font.TintAndShade = 0
ActiveCell.FormulaR1C1 = "=RC[-2]+RC[-1]-8"
Selection.AutoFill Destination:=ActiveCell.Range("A1:A10"), Type:=xlFillDefault
' Apply the color depending on results
' Loop through each cell, do the comparison and apply the color

For x = 1 To Range("G" & Rows.Count).End(xlUp).Row

If Range("G" & x).Value < 0 Then
Range("G" & x).Font.Color = -16776961
Range("G" & x).Font.TintAndShade = 0
Else
Range("G" & x).Font.Color = xlThemeColorLight1
Range("G" & x).Font.TintAndShade = 0
End If
Next


'adding a Chart
Range("E1:H12").Select
ActiveSheet.Shapes.AddChart.Select
ActiveChart.SetSourceData Source:=Range("'Tabelle1'!$E$1:$H$12")
ActiveChart.ChartType = xlLine
ActiveChart.Location Where:=xlLocationAsNewSheet, Name:="Diagramm"
ActiveChart.SetElement (msoElementChartTitleCenteredOverlay)
ActiveChart.ChartTitle.Text = "Chart for workhours"
ActiveChart.SetElement (msoElementPrimaryCategoryAxisTitleAdjacentToAxis)
ActiveChart.Axes(xlCategory, xlPrimary).AxisTitle.Text = "Days"
ActiveChart.SetElement (msoElementPrimaryValueAxisTitleRotated)
ActiveChart.Axes(xlValue, xlPrimary).AxisTitle.Text = "workhours"
Sheets("Diagramm").Select
Sheets("Diagramm").Move Before:=Sheets(3)

End Sub

so where should i put the code that it bugs no other code