Something like this may do the trick
Public Sub validateWorksheetData()
On Error Resume Next
'#
'# declare private variables
'#
Dim pvt_obj_Worksheet As Excel.Worksheet
Dim pvt_obj_ValidationRange As Excel.Range
Dim pvt_obj_ValidationCell As Excel.Range
Dim pvt_obj_ValidationLog As Excel.Worksheet
Dim pvt_lng_ValidationLog As Long
'#
'# initialise
'#
Set pvt_obj_ValidationLog = ThisWorkbook.Worksheets("ValidationLog")
If pvt_obj_ValidationLog Is Nothing Then
ThisWorkbook.Worksheets.Add.Name = "ValidationLog"
Set pvt_obj_ValidationLog = ThisWorkbook.Worksheets("ValidationLog")
End If
'#
'# clear the contents of the validation log worksheet
'#
pvt_lng_ValidationLog = 1
With pvt_obj_ValidationLog
.Cells.ClearContents
.Cells(1, "A").Value = "Worksheet"
.Cells(1, "B").Value = "Address"
.Cells(1, "C").Value = "Input message"
.Columns.AutoFit
End With
'#
'# loop for all worksheets in the current workbook, skip the validation log
'# itself and any other worksheet not relevant
'#
For Each pvt_obj_Worksheet In ThisWorkbook.Worksheets
If pvt_obj_Worksheet.Name <> "ValidationLog" Then
'#
'# initialise a range object to contain all cells on the current worksheet
'# that have a validation rule assigned - if the object does not hold any
'# cells, skip the worksheet
'#
Set pvt_obj_ValidationRange = Nothing
Set pvt_obj_ValidationRange = pvt_obj_Worksheet.Cells.SpecialCells(xlCellTypeAllValidation)
If Not pvt_obj_ValidationRange Is Nothing Then
'#
'# check all cells for a validation violation and when found record the details on the
'# validation log worksheet
'#
For Each pvt_obj_ValidationCell In pvt_obj_ValidationRange.Cells
If Not pvt_obj_ValidationCell.Validation.Value Then
pvt_lng_ValidationLog = pvt_lng_ValidationLog + 1
pvt_obj_ValidationLog.Cells(pvt_lng_ValidationLog, "A").Value = pvt_obj_Worksheet.Name
pvt_obj_ValidationLog.Cells(pvt_lng_ValidationLog, "B").Value = pvt_obj_ValidationCell.Address
pvt_obj_ValidationLog.Cells(pvt_lng_ValidationLog, "C").Value = pvt_obj_ValidationCell.InputMessage
End If
Next pvt_obj_ValidationCell
End If
End If
Next pvt_obj_Worksheet
End Sub
Bookmarks