My Blog

BA – Data Validation and Enforcing it to work

2

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

PROBLEM

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.Delete
        .Validation.Add Type:=xlValidateList, Formula1:="TRUE,FALSE"
        .Value = "SID" '<~~ Trying to pass an invalid value
    End With
End Sub

SOLUTION

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
                    Target.ClearContents
                End If
            End If
        End If
        On Error GoTo 0
    End If
LetsContinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    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
    pradeep121003-16-2012

    Great! Nicely Done. :)