The following bit of VBA will highlight any cells in a sheet with data validation errors:
Sub CheckValidation(sht As Worksheet) Dim cell As Range Dim rngDV As Range Dim dvError As Boolean On Error Resume Next Set rngDV = sht.UsedRange.SpecialCells(xlCellTypeAllValidation) On Error GoTo 0 If rngDV Is Nothing Then sht.ClearCircles Else dvError = False For Each cell In rngDV If Not cell.Validation.Value Then dvError = True Exit For End If Next If dvError Then sht.CircleInvalid sht.Activate Else sht.ClearCircles End If End If End Sub
However, the “For Each” loop runs really slowly in sheets with a lot of data validation.
Does anyone know of a way to avoid the “For Each” loop, or speed it up somehow?
I would have thought that the following would be equivalent to set the value of ‘dvError’:
dvError = Not rngDV.Validation.Value
But for some reason, rngDV.Validation.Value is true even when there are data validation errors.
Tried your code and it’s working quite fast with 4536 cells containing validations – as you are rightly breaking your FOR at the first occurence of an unvalidated cell
I tried to measure time at various points of your code by following:
Dim Tick As Variant Tick = Now() ' ... code Debug.Print "ValCount", rngDV.Cells.Count ' just to see how many cells are in that range ' ... code Debug.Print "Pt1", (Now() - Tick) * 86400000 'display milliseconds ' ... code Debug.Print "Pt2", (Now() - Tick) * 86400000 'display milliseconds ' ... code Debug.Print "Pt3", (Now() - Tick) * 86400000 'display milliseconds ' etc.
and got a not measureable delay (except when stepping thru debugger with F8 – of course)
As a generic hint … try to find out where exactly your code is slow and let’s take it from there.
I had a slightly different requirement where I wanted to restrict the values entered by a user to a valid date range or the text “ASAP” which I resolved using the following;
Private Sub Worksheet_Change(ByVal Target As Range) Dim sErr As String Dim sProc As String On Error GoTo ErrHandler Application.EnableEvents = False Select Case Target.Column Case 11 sProc = "Validate Date" 'The value must be a date between "1 Nov 2011" and "30 Jun 2012" or "ASAP"... If IsDate(Target.Value) Then If Target.Value < CDate("2011-11-01") _ Or Target.Value > CDate("2012-06-30") Then Err.Raise vbObjectError + 1 End If ElseIf LCase(Target.Value) = "asap" Then Target.Value = "ASAP" ElseIf Len(Trim(Target.Value)) = 0 Then Target.Value = vbNullString Else Err.Raise vbObjectError + 1 End If End Select ErrHandler: Select Case Err.Number Case 0 'Nothing to do... Case vbObjectError + 1 sErr = "The Date must be between ""1 Nov 2011"" and ""30 Jun 2012"" or equal ""ASAP""." Case Else sErr = Err.Description End Select If Len(Trim(sErr)) > 0 Then Target.Select MsgBox sErr, vbInformation + vbOKOnly, sProc Target.Value = vbNullString End If Application.EnableEvents = True End Sub