CODEWITHSUNDEEP
vbaexcelvalidation
JKAbrams
JKAbrams

Reputation: 255

Perfect user input validation in Excel VBA

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:

*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!).

Worksheet_Change function

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

Global variables

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

Upvotes: 4

Views: 8531

Answers (1)

JKAbrams
JKAbrams

Reputation: 255

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

Upvotes: 3

Related Questions