My Blog

BA – Data Validation and Enforcing it to work


While answering a question today in StackOverflow, I came across an interesting question. And that inspired me to write a blog post on it.


How to enforce Data Validation to work from VBA. By default you can set a data validation condition from VBA but it doesn’t work if you manually try to set a value to the cell. For example, this piece of code adds a DataValidation to Cell A1 in Sheet1 but doesn’t throw any error message when you supply a different value to the cell.

Sub Sample()
    With Sheets("Sheet1").Range("A1")
        .Validation.Add Type:=xlValidateList, Formula1:="TRUE,FALSE"
        .Value = "SID" '<~~ Trying to pass an invalid value
    End With
End Sub


The solution to the above problem is a “Sideways” enforcing of DataValidation from Worksheet_Change() event. The Worksheet_Change() event is a procedure of the Worksheet Object and as such, it should reside in the private module of the Worksheet Object. This event fires whenever there is a change in the worksheet. There are few changes which of course cannot be trapped from the Worksheet_Change() event. For example – Resizing of Columns. So back to the point.

The logic that we have to use
  • 1) Check if the change is happening in the relevant cell. For this we can use Intersect() method.
  • 2) And if the change is happening in the the relevant cell, then check if the cell has a DataValidation.
  • 3) If the cell has DataValidation then check for the “Type” of DataValidation.
  • 4) Once the type has been ascertained, check if the current value of the cell conforms to the formula of the DataValidation.
Const dvMessage = "Incorrect Value. Please ensure that the value conforms to the Data Validation set on the cell"

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Whoa

    If Not Intersect(Target, Range("A1")) Is Nothing Then
        Application.EnableEvents = False

        On Error Resume Next
        If Not Target.SpecialCells(xlCellTypeSameValidation).Cells.Count < 1 Then
            Dim currentValidation As Excel.Validation
            Set currentValidation = Target.Validation

            If currentValidation.Type = xlValidateList Then
                Dim MyArray() As String
                Dim boolFound As Boolean

                MyArray = Split(currentValidation.Formula1, ",")

                For i = 0 To UBound(MyArray)
                    If UCase(Target.Value) = UCase(MyArray(i)) Then
                        boolFound = True
                        Exit For
                    End If
                Next i

                If boolFound = False Then
                    MsgBox dvMessage
                End If
            End If
        End If
        On Error GoTo 0
    End If
    Application.EnableEvents = True
    Exit Sub
    MsgBox Err.Description
    Resume LetsContinue
End Sub

With slight modification, the above code can also work very well for xlValidateWholeNumber, xlValidateCustom, xlValidateDecimal, xlValidateDate, xlValidateTime, xlValidateTextLength and xlValidateCustom

  1. pradeep1210

    Great! Nicely Done. :)