Determine if a cell contains data validation

Question

I am writing VBA code that goes through a range of cells checking whether each cell has data validation (drop-down menu), and if you do not assign it from a list on another sheet.

I am currently having problems with a line that checks if the current cell already has data validation. I get error 1004 "no cells were found."

Sub datavalidation() Dim nlp As Range Dim lrds As Long Dim wp As Double Dim ddrange As Range Sheets("DataSheet").Select lrds = ActiveSheet.Range("A1").Offset(ActiveSheet.rows.Count - 1, 0).End(xlUp).Row Set nlp = Range("I3:I" & lrds) For Each cell In nlp 'error on following line If cell.SpecialCells(xlCellTypeSameValidation).Cells.Count < 1 Then wp = cell.Offset(0, -8).Value Set ddrange = ddrangefunc(wp) End If Next End Sub 

Any ideas? thank you

Answer 1

 Dim cell As Range, v As Long For Each cell In Selection.Cells v = 0 On Error Resume Next v = cell.SpecialCells(xlCellTypeSameValidation).Count On Error GoTo 0 If v = 0 Then Debug.Print "No validation" Else Debug.Print "Has validation" End If Next 

Answer 2

I know this question is old, but since it appears when Googling “excel vba checks if the cell has validation”, I decided that I would add my own grain of salt.

If the Range object you call SpecialCells on represents only one cell, the entire sheet will be scanned to find matches. If you have a very large amount of data, the methods given in the previous answers may slow down a bit.

Therefore, here is a more efficient way to check if a single cell has validation:

 Function HasValidation(cell As Range) As Boolean Dim t: t = Null On Error Resume Next t = cell.Validation.Type On Error GoTo 0 HasValidation = Not IsNull(t) End Function 

Answer 3

If you want to test only the active cell, then:

 Sub dural() Dim r As Range On Error GoTo noval Set r = Cells.SpecialCells(xlCellTypeAllValidation) If Intersect(r, ActiveCell) Is Nothing Then GoTo noval MsgBox "Active cell has validation." Exit Sub noval: MsgBox "Active cell has no validation." On Error GoTo 0 End Sub 

Answer 4

In addition, if you want to receive Source confirmation, you can use the following ...

 Dim cell as Range Dim rng as Range Set rng = Range("A1:A10") 'enter your range On Error Resume Next 'will skip over the cells with no validation For Each cell In rng msgbox cell.Validation.Formula1 Next cell 

Answer 5

It works for me

 Sub test() On Error Resume Next If ActiveCell.SpecialCells(xlCellTypeSameValidation).Cells.Count < 1 Then MsgBox "validation" Else MsgBox "no Validation" End If On Error GoTo 0 End Sub 

Answer 6

About 4 years later, I am also looking for a cell check. Combining several of the answers here is what I came up with:

 Option Explicit Public Sub ShowValidationInfo() Dim rngCell As Range Dim lngValidation As Long For Each rngCell In ActiveSheet.UsedRange lngValidation = 0 On Error Resume Next lngValidation = rngCell.SpecialCells(xlCellTypeSameValidation).Count On Error GoTo 0 If lngValidation <> 0 Then Debug.Print rngCell.Address Debug.Print rngCell.Validation.Formula1 Debug.Print rngCell.Validation.InCellDropdown End If Next End Sub 

Answer 7

Looking for a way to deal with this, avoiding the appearance of an error further, I implement it as follows:

 Option Explicit ' https://stackoverflow.com/questions/18642930/determine-if-cell-contains-data-validation ' Use this if you want to omit doing something to the cell added: http://dailydoseofexcel.com/archives/2007/08/17/two-new-range-functions-union-and-subtract/ Sub ValidationCells() Dim theSheet As Worksheet Dim lastCell As Range Dim validationRange As Range Dim validationCell As Range Application.EnableEvents = False ' optional Set theSheet = ThisWorkbook.Worksheets(1) theSheet.Unprotect ' optional ' Add a cell with a value and some validation to bypass specialcells error Set lastCell = theSheet.Cells(1, theSheet.Cells.Columns.Count) With lastCell .Value2 = 1 .Validation.Add xlValidateWholeNumber, xlValidAlertInformation, xlEqual, "1" End With ' If usedrange is greater than 1 (as we added a single cell previously) If theSheet.UsedRange.Rows.Count > 1 Or theSheet.UsedRange.Columns.Count > 1 Then Set validationRange = theSheet.UsedRange.SpecialCells(xlCellTypeAllValidation) MsgBox validationRange.Address For Each validationCell In validationRange If validationCell.Address <> lastCell.Address Then MsgBox validationCell.Address End If Next validationCell End If lastCell.Clear Set validationRange = Nothing Set lastCell = Nothing theSheet.Protect ' optional Application.EnableEvents = True ' optional End Sub