looping code, a better way ?

**trevor40** · 01-11-2015, 03:21 AM

I have this code that loops though Cells on a whorksheet to add data validation. I have 4 loops one for each Column, the Rows auto-populate in the excel table.
I'm sure there's a better way to write the code with 2 for loops and adding A B C D to each of them, any help whould be great thanks.

For I = 8 To Mid(last_cell, 4, 3)
With Current_Worksheet.Range("C" & I).Cells.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=A104:A152"
.IgnoreBlank = True
.InCellDropdown = True
.ErrorMessage = "The time entered must be in multples of 15 minutes" & vbCrLf & " Between 6:30AM and 6:30PM"
.ShowInput = True

.ShowError = True
End With
Next I
For I = 8 To Mid(last_cell, 4, 3)
With Current_Worksheet.Range("D" & I).Cells.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=A104:A152"
.IgnoreBlank = True
.InCellDropdown = True
.ErrorMessage = "The time entered must be in multples of 15 minutes" & vbCrLf & " Between 6:30AM and 6:30PM"
.ShowInput = True
.ShowError = True
End With
Next I
For I = 8 To Mid(last_cell, 4, 3)
With Current_Worksheet.Range("E" & I).Cells.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=A104:A152"
.IgnoreBlank = True
.InCellDropdown = True
.ErrorMessage = "The time entered must be in multples of 15 minutes" & vbCrLf & " Between 6:30AM and 6:30PM"
.ShowInput = True
.ShowError = True
End With
Next I
For I = 8 To Mid(last_cell, 4, 3)
With Current_Worksheet.Range("F" & I).Cells.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=A104:A152"
.IgnoreBlank = True
.InCellDropdown = True
.ErrorMessage = "The time entered must be in multples of 15 minutes" & vbCrLf & " Between 6:30AM and 6:30PM"
.ShowInput = True
.ShowError = True
End With
Next I

**June7** · 01-11-2015, 03:45 AM

This worked for me:

Code:

For c = 1 To 4
    For r = 8 To 24
       With Worksheets("Sheet1").Cells(r, c).Validation
       .Delete
       .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=A104:A152"
       .IgnoreBlank = True
       .InCellDropdown = True
       .ErrorMessage = "The time entered must be in multples of 15 minutes" & vbCrLf & " Between 6:30AM and 6:30PM"
       .ShowInput = True
       .ShowError = True
       End With
    Next
Next

Since all cells have the same validation rule, instead of looping, could select the entire range.
Range("A8:D24").Select
With Selection.Validation
...
End With

**trevor40** · 01-11-2015, 04:13 AM

Thanks for the reply, i managed to figure it out

I'll try out your solution as well.
thanks.

Dim myarray, loop_cells As Variant
myarray = Array("C", "D", "E", "F")
For ii = 0 To 3
t = myarray(ii)
For I = 8 To Mid(last_cell, 4, 3)
With Current_Worksheet.Range(t & I).Cells.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=A104:A152"
.IgnoreBlank = True
.InCellDropdown = True
.ErrorMessage = "The time entered must be in multples of 15 minutes" & vbCrLf & " Between 6:30AM and 6:30PM"
.ShowInput = True
.ShowError = True
End With
Next I
Next ii

**June7** · 01-11-2015, 04:15 AM

Array is good. Glad you figured it out.

**trevor40** · 01-11-2015, 04:30 AM

Ok so I tried grouping as shown, sorry if I forgot to mention that I'm doing all this from Access VBA,

It doe's complete but the results - Col C lookups up A104:A152 correctly, Col D lookups up B104:B152, E lookups up C104:C152, F lookups up D104

152
As you can see each loop through each column increments the reference as well, don't know why. It could be because it's in an Excel table. The sum below is only put into cell M8, the table then adds it to all rows in column M of the table for me.

Current_Worksheet.Range("M8").Formula = "=IF(OR(TEXT($B8," & Chr(34) & "Ddd" & Chr(34) & ") = " & Chr(34) & "Sat" & Chr(34) & ", TEXT($B8," & Chr(34) & "Ddd" & Chr(34) & ") = " & Chr(34) & "Sun" & Chr(34) & "), 0, IF($K8*24 > 8, 8, ($K8*24)))"

so i have to do it by each column, I've had this problem with a lot of things, text boxes, validation, icon sets were fun!

With Current_Worksheet.Range("C8:F" & Mid(last_cell, 4, 3)).Cells.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=A104:A152"
.IgnoreBlank = True
.InCellDropdown = True
.ErrorMessage = "The time entered must be in multples of 15 minutes" & vbCrLf & " Between 6:30AM and 6:30PM"
.ShowInput = True
.ShowError = True
End With

So I'm back to this.

Dim myarray, loop_cells As Variant
myarray = Array("C", "D", "E", "F")
For ii = 0 To 3
t = myarray(ii)
For I = 8 To Mid(last_cell, 4, 3)
With Current_Worksheet.Range(t & I).Cells.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=A104:A152"
.IgnoreBlank = True
.InCellDropdown = True
.ErrorMessage = "The time entered must be in multples of 15 minutes" & vbCrLf & " Between 6:30AM and 6:30PM"
.ShowInput = True
.ShowError = True
End With
Next I
Next ii

**June7** · 01-11-2015, 12:59 PM

Sorry, I should have suggested absolute Referencing:

"=$A$104:$A$152"

**trevor40** · 01-11-2015, 08:58 PM

Hi June7, I retried your code with the absolute ref, and it does work, I may have even had that at one stage!

With Current_Worksheet.Range("C8:F" & Mid(last_cell, 4, 3)).Cells.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=$A$104:$A$152"
.IgnoreBlank = True
.InCellDropdown = True
.ErrorMessage = "The time entered must be in multples of 15 minutes" & vbCrLf & " Between 6:30AM and 6:30PM"
.ShowInput = True
.ShowError = True
End With

I'll create a new thread for this but...

PS thanks for the help with the code to include text strings (I have lots of them now!) - sample - Current_Worksheet.Range("N8").Formula = "=IF(TEXT($B8," & Chr(34) & "Ddd" & Chr(34) & ")=" & Chr(34) & "Sun" & Chr(34) & ",0,IF(AND(TEXT($B8," & Chr(34) & "Ddd" & Chr(34) & ")=" & Chr(34) & "Sat" & Chr(34) & ",$K8*24>4),4,IF(AND(TEXT($B8," & Chr(34) & "Ddd" & Chr(34) & ")=" & Chr(34) & "Sat" & Chr(34) & ",$K8*24<=4),$K8*24,IF(AND(NOT(TEXT($B8," & Chr(34) & "Ddd" & Chr(34) & ")=" & Chr(34) & "Sat" & Chr(34) & "),NOT(TEXT($B8," & Chr(34) & "Ddd" & Chr(34) & ")=" & Chr(34) & "Sun" & Chr(34) & ")),IF(AND($K8*24>8, $K8*24<=11), (($K8*24)-8),IF($K8*24>=11, 3,IF($K8*24<=8,$K8-$K8)))))))"

My problem is with the MOD function, but only when it's in a validation condition

The MOD function here works fine,
Current_Worksheet.Range("G8:G" & Mid(last_cell, 4, 3)).Formula = "=IF(OR(ISBLANK(A8),ISBLANK(C8),ISBLANK(D8),ISBLAN K(F8),ISBLANK(F8),MOD(MINUTE(C8),15)>0,MOD(MINUTE(D8),15)>0,MOD(MINU TE(E8),15)>0,MOD(MINUTE(F8),15)>0,(H8)<=0,(C8)>(D8),(D8)>(E8),(E8)>(F8),ISERROR(H8) ,ISERROR(I8),ISERROR(O8),ISERROR(P8)),1,IF(OR((C8) <0.270833333,(C8)>0.770833334),1,IF(OR((D8)<0.2708 33333,(D8)>0.770833334),1,IF(OR((E8)<0.270833333,( E8)>0.770833334),1,IF(OR((F8)<0.270833333,(F8)>0.7 70833334),1,10)))))"

The ISBLANK function works fine, but if I try and change the function to - it fails with -

Current_Worksheet.Range("A8:F" & Mid(last_cell, 4, 3)).Select
With Selection
Current_Worksheet.Range("A8:F" & Mid(last_cell, 4, 3)).FormatConditions.Add Type:=xlExpression, Formula1:="=ISblank(A8:F" & Mid(last_cell, 4, 3)
Current_Worksheet.Range("A8:F" & Mid(last_cell, 4, 3)).FormatConditions(1).Interior.Color = 255
End With

What I'd like to be able to do is repalce the above ISBLANK function with the MOD function, but can't get the syntax correct.

Used for when the cell is not blank and the value is not a multiple of 15 minutes
Current_Worksheet.Range("A8:F" & Mid(last_cell, 4, 3)).Select
With Selection
Current_Worksheet.Range("A8:F" & Mid(last_cell, 4, 3)).FormatConditions.Add Type:=xlExpression, Formula1:="=MOD(MINUTE(A8:F" & Mid(last_cell,4,3)),15)>0
Current_Worksheet.Range("A8:F" & Mid(last_cell, 4, 3)).FormatConditions(1).Interior.Color = 255
End With

any help would be great.

**June7** · 01-11-2015, 09:35 PM

This is missing closing ) for the ISBLANK()

Formula1:="=ISBLANK(A8:F" & Mid(last_cell, 4, 3) & ")"

Try:

Formula1:="=MOD(MINUTE(A8:F" & Mid(last_cell, 4, 3) & "),15)>0"

**trevor40** · 01-12-2015, 03:54 PM

Originally Posted by June7

This is missing closing ) for the ISBLANK()

Formula1:="=ISBLANK(A8:F" & Mid(last_cell, 4, 3) & ")"

Try:

Formula1:="=MOD(MINUTE(A8:F" & Mid(last_cell, 4, 3) & "),15)>0"

got it going - MOD(MINUTE(C8:F" & Mid(last_cell, 4, 3) & "),15)>0"

' Check for time in 15 minute increments
Current_Worksheet.Range("C8:F" & Mid(last_cell, 4, 3)).Select
With Selection
Current_Worksheet.Range("C8:F" & Mid(last_cell, 4, 3)).FormatConditions.Add Type:=xlExpression, Formula1:="=MOD(MINUTE(C8:F" & Mid(last_cell, 4, 3) & "),15)>0"
Current_Worksheet.Range("C8:F" & Mid(last_cell, 4, 3)).FormatConditions(3).Interior.Color = 49407
End With

looping code, a better way ?

Thread Tools

looping code, a better way ?

Similar Threads

Looping thru fields.

Looping

Looping in Access

Looping code for printing reports

Looping syntax

Posting Permissions