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.Delete .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 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