I need to validate user input on when cells change and show the error in another cell in Excel using VBA.
I run into problems where my validator is called on all cells in the sheet when a user inserts rows or column which makes Excel unresponsive for a long time, how can I fix this?
Below are my requirements and my current solution with full documentation.
Definition and requirements
Consider the following table:
Example User Input Table
| | | Tolerance | | | | Type | Length | enabled | Tolerance | Note | |------|--------|-----------|-----------|----------------------------| | | 4 | 0 | | Type is missing | | | | 0 | | Type is missing | | C | 40 | 1 | 110 | | | D | 50 | 1 | | Tolerance is missing | | | | | | |
The idea is that the user inputs values in the table, once a value has been changed (the user leaves the cell) the value is validated and if there is a problem the error is printed in the Note column.
Blank lines should be ignored.
I need this to be robust meaning it should not fail on any user input, that means it has to work for the following cases:
- Paste values
- Delete rows
- Insert rows (empty or cut cells)
- Insert/delete columns *
- Any other case I missed thinking about?
*It is OK if the the validation fails when a user is deleting a column that is part of the table as this is seen as the user willfully vandalizing the sheet, but it has to fail gracefully (i.e. not by validating all cells in the worksheet which takes a long time). It would have been great if this action was undoable, however my current understanding of Excel suggests this is impossible (after a macro has changed something in the sheet, nothing can be undone anymore).
The Note cell can only contain one error at a time, for the user the most relevant error is the one for the cell the user last changed, so it should display this error first. After the user fixes that error the order is not that important anymore, so it could just display the errors from left to right.
Problems with current approach
My problem is that when rows/columns are inserted validation is triggered for all cells in the sheet which is a very slow process and to the user it looks like the program has crashed, but it will return once the validation is complete.
I don’t know why Excel does this but I need a way to work around it.
Code placed in a Sheet named ‘User Input’
My solution is based on the only on change event handler I know of: the per sheet global Worksheet_Change function (ugh!).
First it checks if the changed cell(s) intersects with the cells I’m interested in validating. This check is actually quite fast.
OldRowCount here is a try to catch the user inserting or deleting cells depending on how the used range changes, however this only solves some cases and introduces problems whenever Excel forgets the global variable (which happens now and then for as to me unknown reasons) as well as the first time the function is run.
The for loop makes it work for pasted values.
Option Explicit Public OldRowCount As Long ' Run every time something is changed in the User Input sheet, it then filters on actions in the table Private Sub Worksheet_Change(ByVal Target As Range) Dim NewRowCount As Long NewRowCount = ActiveSheet.UsedRange.Rows.count If OldRowCount = NewRowCount Then If Not Intersect(Target, Me.Range(COL_TYPE & ":" & COL_TOLERANCE)) Is Nothing Then Dim myCell As Range ' This loop makes it work if multiple cells are changed, for example while pasting cells For Each myCell In Target.Cells ' Protect the header rows If myCell.row >= ROW_FIRST Then checkInput_cell myCell.row, myCell.Column, Me End If Next End If ElseIf OldRowCount > NewRowCount Then 'Row deleted, won't have to deal with this as it solves itself OldRowCount = NewRowCount ElseIf OldRowCount < NewRowCount Then Debug.Print "Row added, TODO: deal with this" OldRowCount = NewRowCount End If End Sub
Code placed in a module
Defines the rows/columns to be validated.
Option Explicit ' User input sheet set up Public Const ROW_FIRST = 8 Public Const COL_TYPE = "B" Public Const COL_LENGTH = "C" Public Const COL_TOLERANCE_ENABLED = "D" Public Const COL_TOLERANCE = "E" Public Const COL_NOTE = "G"
Cell checking function
This function validates the given cell unless the row where the cell is is empty.
Meaning we are only interested in validating cells on rows where the user has actually started giving values. Blank rows is not a problem.
It first validates the currently changed cell, if it is OK it will then validate the other cells on the given row (since some cells validation depends the values of other cells, see Tolerance enabled in my example table above).
The note will only ever contain one error message at a time, the above is done so that we always get the error of the last changed cell in the Note cell.
Yes, this will make the checker run twice on the current cell, while it is not a problem it could be avoided by a more complex if statement, but for simplicity I skipped it.
Sub checkInput_cell(thisRow As Long, thisCol As Long, sheet As Worksheet) Dim note As String note = "" With sheet ' Ignore blank lines If .Range(COL_TYPE & thisRow).value <> "" _ Or .Range(COL_LENGTH & thisRow).value <> "" _ Or .Range(COL_TOLERANCE_ENABLED & thisRow).value <> "" _ Or .Range(COL_TOLERANCE & thisRow).value <> "" _ Then ' First check the column the user changed If col2Let(thisCol) = COL_TYPE Then note = check_type(thisRow, sheet) ElseIf col2Let(thisCol) = COL_LENGTH Then note = check_length(thisRow, sheet) ElseIf col2Let(thisCol) = COL_TOLERANCE_ENABLED Then note = check_tolerance_enabled(thisRow, sheet) ElseIf col2Let(thisCol) = COL_TOLERANCE Then note = check_tolerance(thisRow, sheet) End If ' If that did not result in an error, check the others If note = "" Then note = check_type(thisRow, sheet) If note = "" Then note = check_length(thisRow, sheet) If note = "" Then note = check_tolerance_enabled(thisRow, sheet) If note = "" Then note = check_tolerance(thisRow, sheet) End If ' Set note string (done outside the if blank lines checker so that it will reset the note to nothing on blank lines) ' only change it actually set it if it has changed (optimization) If Not .Range(COL_NOTE & thisRow).value = note Then .Range(COL_NOTE & thisRow).value = note End If End With End Sub
Validators for individual columns
These functions takes a row and validate the a certain column according to it’s special requirements. Returns a string if the validation fails.
' Makes sure that type is : ' Unique in its column ' Not empty Function check_type(affectedRow As Long, sheet As Worksheet) As String Dim value As String Dim duplicate_found As Boolean Dim lastRow As Long Dim i As Long duplicate_found = False value = sheet.Range(COL_TYPE & affectedRow).value check_type = "" ' Empty value check If value = "" Then check_type = "Type is missing" Else ' Check for uniqueness lastRow = sheet.Range(COL_TYPE & sheet.Rows.count).End(xlUp).row If lastRow > ROW_FIRST Then For i = ROW_FIRST To lastRow If Not i = affectedRow And sheet.Range(COL_TYPE & i).value = value Then duplicate_found = True End If Next End If If duplicate_found Then check_type = "Type has to be unique" Else ' OK End If End If End Function ' Makes sure that length is a whole number larger than -1 Function check_length(affectedRow As Long, sheet As Worksheet) As String Dim value As String value = sheet.Range(COL_LENGTH & affectedRow).value check_length = "" If value = "" Then check_length = "Length is missing" ElseIf IsNumeric(value) Then If Not Int(value) = value Then check_length = "Length cannot be decimal" ElseIf value < 0 Then check_length = "Length is below 0" ElseIf InStr(1, value, ".") > 0 Then check_length = "Length contains a dot" Else ' OK End If ElseIf Not IsNumeric(value) Then check_length = "Length is not a number" End If End Function ' Makes sure that tolerance enabled is either 1 or 0: Function check_tolerance_enabled(affectedRow As Long, sheet As Worksheet) As String Dim value As String value = sheet.Range(COL_TOLERANCE_ENABLED & affectedRow).value check_tolerance_enabled = "" If Not value = "0" And Not value = "1" Then check_tolerance_enabled = "Tolerance enabled has to be 1 or 0" Else ' OK End If End Function ' Makes sure that tolerance is a whole number larger than -1 ' But only checks tolerance if it is enabled in the tolerance enabled column Function check_tolerance(affectedRow As Long, sheet As Worksheet) As String Dim value As String value = sheet.Range(COL_TOLERANCE & affectedRow).value check_tolerance = "" If value = "" Then If sheet.Range(COL_TOLERANCE_ENABLED & affectedRow).value = 1 Then check_tolerance = "Tolerance is missing" End If ElseIf IsNumeric(value) Then If Not Int(value) = value Then check_tolerance = "Tolerance cannot be decimal" ElseIf value < 0 Then check_tolerance = "Tolerance is below 0" ElseIf InStr(1, value, ".") > 0 Then check_tolerance = "Tolerance contains a dot" Else ' OK End If ElseIf Not IsNumeric(value) Then check_tolerance = "Tolerance is not a number" End If End Function
Addressing support functions
These functions translates a letter to a column and vice versa.
Function let2Col(colStr As String) As Long let2Col = Range(colStr & 1).Column End Function Function col2Let(iCol As Long) As String Dim iAlpha As Long Dim iRemainder As Long iAlpha = Int(iCol / 27) iRemainder = iCol - (iAlpha * 26) If iAlpha > 0 Then col2Let = Chr(iAlpha + 64) End If If iRemainder > 0 Then col2Let = col2Let & Chr(iRemainder + 64) End If End Function
Code is tested on/has to work for Excel 2010 and onwards.
Edited for clarity
Finally got it working
After quite a bit of more agonizing, it turned out the fix was quite easy.
- I added a new test that checks if the area that the user changed (the Target Range) consists of a column by looking at the address of the Range, if it is a full column the checker will ignore it. This solves the problem where the validation hogs Excel for about one minute.
- The result of the intersection calculation is used for the inner loop which limits checks to cells within the area we are interested in validating.
Fixed Worksheet_Change function
Option Explicit ' Run every time something is changed in the User Input sheet Private Sub Worksheet_Change(ByVal Target As Range) Dim InterestingRange As Range Set InterestingRange = Intersect(Target, Me.Range(COL_TYPE & ":" & COL_TOLERANCE)) If Not InterestingRange Is Nothing Then ' Guard against validating every cell in an inserted column If Not RangeAddressRepresentsColumn(InterestingRange.address) Then Dim myCell As Range ' This loop makes it work if multiple cells are changed, ' for example when pasting cells For Each myCell In InterestingRange.Cells ' Protect the header rows If myCell.row >= ROW_FIRST Then checkInput_cell myCell.row, myCell.Column, Me End If Next End If End If End Sub
New support function
' Takes an address string as input and determines if it represents a full column ' A full column is on the form $A:$A for single or $A:$C for multiple columns ' The unique characteristic of a column address is that it has always two ' dollar signs and one colon Public Function RangeAddressRepresentsColumn(address As String) As Integer Dim dollarSignCount As Integer Dim hasColon As Boolean Dim Counter As Integer hasColon = False dollarSignCount = 0 ' Loop through each character in the string For Counter = 1 To Len(address) If Mid(address, Counter, 1) = "$" Then dollarSignCount = dollarSignCount + 1 ElseIf Mid(address, Counter, 1) = ":" Then hasColon = True End If Next If hasColon And dollarSignCount = 2 Then RangeAddressRepresentsColumn = True Else RangeAddressRepresentsColumn = False End If End Function