Excellent, thanks for the solution works like a charm. I've been trying to
sort this out for ages. Much appreciated!!


"Rocky McKinley" wrote in message
...
I changed it slightly it should work now, try not to use "selection" if at
all possible it slows things down to much and causes unnecessary errors.

Sub Set_Validation_Use_By_Date()
Dim wsheet As Worksheet
For Each wsheet In ActiveWorkbook.Worksheets

With Range("L10:L169").Validation
.Delete
.Add Type:=xlValidateDate, AlertStyle:=xlValidAlertStop,
Operator:=
_
xlGreater, Formula1:="=TODAY()"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = "Date Error"
.InputMessage = ""
.ErrorMessage = _
"The date you have entered is in the past. Please check the date
and
enter again."
.ShowInput = True
.ShowError = True
End With
Next
End Sub

--
Regards,
Rocky McKinley


"Insp Gadget " <oakeypara<<REMOVE wrote in message
...
Can any one help me with this loop. I'm trying to set the validations
for
a
range of cell over all the worksheets in my workbook, but for some
reason
it
will only change the validations for the active sheet. If I change the
code
to something simple like "MsgBox wsheet.Name" it cycles through all the
sheets. The main part of the code was copied from a recorded macro and
added
to the loop code.

Here is the code:

Sub Set_Validation_Use_By_Date()
Dim wsheet As Worksheet
For Each wsheet In ActiveWorkbook.Worksheets
Range("L10:L169").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateDate, AlertStyle:=xlValidAlertStop,
Operator:=
_
xlGreater, Formula1:="=TODAY()"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = "Date Error"
.InputMessage = ""
.ErrorMessage = _
"The date you have entered is in the past. Please check the date
and
enter again."
.ShowInput = True
.ShowError = True
End With
Next
End Sub

Any ideas would be greatly appreciated.

Insp Gadget