Check Entry – Marking Cells as having passed or failed

The last post talked about a generic validation routine.  That routine requires some functions that I will provide code for in this post.

These functions convey to users and other routines which cells: can change; have changed, have passed validation; or have failed.  Users need this information to know what can be changed and what needs fixing.  The other routines need this information to know what has changed and needs checking, and what has passed validation and doesn’t need to be checked again.  To convey this information we use a simple technique, color. 

The colors I use are culturally well suited for my audience: pale yellow for changed but not yet verified; pale green for passed validation; and pale red for needs fixing.  You can easily change the colors to suit your preferences and culture.

In addition, I’ve included another routine that is referenced in the prior post, Fields_Field_Column.  That routine finds a string within curly brackets.  The curly brackets are used in the Fields Definition file when the “XLT” (Excel Type Table) validation rule is indicated in the “V.Type” column.  Before we explain much else, let’s look at an example of the XLT rule in action.  In this example, suppose we have an Excel Range called “States” containing Country Codes, associated State Codes, and the name of the states like this small sample:

States Table      

When the country is ”US” we need to restrict State Codes to those for which the “Type” is “US”.  Now let’s also suppose we have entries for sales by state/province that looked something like this:

Entries            

We can tell Check_For_Normal_Entry_Errors to impose this rule by coding the Fields Definition Table like this:

“Heading” = “State/Province”
“V.Type” = ”XLT”
“V.Table” =”States {Country}” 

This basically says, make sure entries for the ”State/Province” column are in the “States” table where the States Table “Type” equals the “Country” column for each entry.

Twenty/Twenty hind sight tells me I should have named the routine something far different.  At some point in the future I will.  But there’s nothing stopping you from naming it something that makes more sense to you.  You’ve got all of the code.  Do what you want with it. 

Function Fields_Field_Column(sFields As String, sString As String, _
                             Optional iStart As Integer) As Long

‘   Description:Determine which field in the “Fields Definition Table” is
‘               indicated by a value in curly brackets

‘   Parameters: sFields     The name of the “Fields Definition Table” range
‘               sString     A string containing the value in curly brackets
‘               iStart      [Optional: assumed to be 1] Which character to
‘                           start search for curly bracket
‘   Example:    lCol = Fields_Field_Column(“Fields”, “Products {Category}”)

‘     Date   Init Modification
‘   04/05/10 CWH  Initial Programming

    On Error GoTo ErrHandler            ‘
    Fields_Field_Column = 0             ‘Assume the Worst

    Dim iBeg As Integer                 ‘Start of sub-string
    Dim iEnd As Integer                 ‘End of sub-string
    Dim s As String                     ‘Sub String
    Dim lRow As Long                    ‘Current Row Number
    Dim lRows As Long                   ‘Number of rows in sFields
        lRows = Range(sFields).Rows.Count
    Dim lColFld As Long
        lColFld = FieldColumn(“Field”, sFields)
    Dim lColHdg As Long
        lColHdg = FieldColumn(“Heading”, sFields)
   
    If iStart <= 0 Then iStart = 1
   
    ‘Search for left curly bracket – designating start of a field
     iBeg = InStr(iStart, sString, “{“)
     If iBeg > 0 Then
        iEnd = InStr(iStart, sString, “}”)
       ‘s equals name of a field, or heading in the Fields Table
        s = Mid(sString, iBeg + 1, iEnd – 1 – iBeg)
       ‘Search Fields Table to determine field # referenced
        With Range(sFields)
            For lRow = 2 To lRows
                If Trim(.Cells(lRow, lColFld)) = s Or _
                   Trim(.Cells(lRow, lColHdg)) = s Then
                    Fields_Field_Column = lRow – 1
                    Exit For
                End If
            Next lRow
        End With
    End If
   
ErrHandler:
   
    If Err.Number <> 0 Then MsgBox _
        “Fields_Field_Column – Error#” & Err.Number & vbCrLf & _
        Err.Description, vbCritical, “Error”, Err.HelpFile, Err.HelpContext
    On Error GoTo 0

End Function

Option Explicit

‘Color codes for cell validation states
Global Const CellUnchecked = 11862015   ‘Light Yellow
Global Const FontUnchecked = 8388608    ‘Dark Blue

Global Const CellChecked = 13434828     ‘Light Green
Global Const FontChecked = 8388608      ‘Dark Blue

Global Const CellError = 10066431       ‘Light Red
Global Const FontError = 0              ‘Black

Global Const CellLocked = 16777215      ‘White
Global Const FontLocked = 128           ‘Maroon

Function Cell_Lock(rngRange As Range) As Boolean

‘   Description:Locks cells to prevent user modifications

‘   Parameters: rngRange    Cell to lock
‘   Example:    bResult = Cell_Lock(“A4″)

‘     Date   Init Modification
‘   01/01/01 CWH  Initial Programming
   
    Cell_Lock = Failure                 ‘Assume the Worst
    On Error GoTo ErrHandler
   
    Dim Cell As Range
   
    For Each Cell In rngRange
        With Cell
            .Locked = True
            .Interior.Color = CellLocked
            .Font.Color = FontLocked
        End With
    Next
      
    Cell_Lock = Success

ErrHandler:
   
    If Err.Number <> 0 Then MsgBox _
        “Cell_Lock – Error#” & Err.Number & vbCrLf & _
        Err.Description, vbCritical, “Error”, Err.HelpFile, Err.HelpContext
    On Error GoTo 0

End Function

Function Cell_Unlock(rngRange As Range) As Boolean

‘   Description:Opens cells for entries & marks as unchecked

‘   Parameters: rngRange    Cell to unlock
‘   Example:    bResult = Cell_UnLock(“A4″)

‘     Date   Init Modification
‘   01/01/01 CWH  Initial Programming
   
    Cell_Unlock = Failure          ‘Assume the Worst
    On Error GoTo ErrHandler
   
    Dim Cell As Range
   
    For Each Cell In rngRange
        With Cell
            .Locked = False
            .Interior.Color = CellUnchecked
            .Font.Color = FontUnchecked
        End With
    Next
   
    Cell_Unlock = Success

ErrHandler:
   
    If Err.Number <> 0 Then MsgBox _
        “Cell_Unlock – Error#” & Err.Number & vbCrLf & _
        Err.Description, vbCritical, “Error”, Err.HelpFile, Err.HelpContext
    On Error GoTo 0

End Function

Function Cell_UnChecked(rngRange As Range) As Boolean

‘   Description:Marks a cell as unchecked
‘               Will not open locked cells

‘   Parameters: rngRange    Cell to unlock
‘   Example:    bResult = Cell_UnChecked(“A4″)

‘     Date   Init Modification
‘   01/01/01 CWH  Initial Programming
   
    Cell_UnChecked = Failure        ‘Assume the Worst
    On Error GoTo ErrHandler
   
    Dim Cell As Range
   
    For Each Cell In rngRange
        With Cell
            If Not .Locked Then
                .Interior.Color = CellUnchecked
                .Font.Color = FontUnchecked
            End If
        End With
    Next
   
    Cell_UnChecked = Success

ErrHandler:
   
    If Err.Number <> 0 Then MsgBox _
        “Cell_UnChecked – Error#” & Err.Number & vbCrLf & _
        Err.Description, vbCritical, “Error”, Err.HelpFile, Err.HelpContext
    On Error GoTo 0

End Function

Function Cell_Error(rngCell As Range, Optional rngMsg As Range, _
                    Optional sMsg As String) As Boolean

‘   Description:Marks a single cell as in error (failed Check_Entry)

‘   Parameters: rngCell Cell containing invalid entry
‘               rngMsg  Cell that can display error messages
‘               sMsg    Error description
‘   Example:    bResult = Cell_Error(“A4″, “H4″, _
                    “Customer number not found in the Customer Master”)

‘     Date   Init Modification
‘   01/01/01 CWH  Initial Programming
   
    Cell_Error = Failure          ‘Assume the Worst
    On Error GoTo ErrHandler
   
    With rngCell
        .Locked = False
        .Interior.Color = CellError
        .Font.Color = FontError
       ‘Add Error message
        If Trim(sMsg) > “” Then _
            rngMsg = rngMsg & IIf(Len(rngMsg) > 0, vbLf, “”) & sMsg
    End With

    Cell_Error = Success

ErrHandler:
   
    If Err.Number <> 0 Then MsgBox _
        “Cell_Error – Error#” & Err.Number & vbCrLf & _
        Err.Description, vbCritical, “Error”, Err.HelpFile, Err.HelpContext
    On Error GoTo 0

End Function

Function Cell_Checked(rngRange As Range) As Boolean

‘   Description:Marks a cell as validated
‘               Will not open locked cells

‘   Parameters: rngCell Cell containing validated entry

‘   Example:    bResult = Cell_Checked(“A4″)

‘     Date   Init Modification
‘   01/01/01 CWH  Initial Programming
   
    Cell_Checked = Failure          ‘Assume the Worst
    On Error GoTo ErrHandler
   
    Dim Cell As Range
   
    For Each Cell In rngRange
        With Cell
            If Not .Locked Then
                .Interior.Color = CellChecked
                .Font.Color = FontChecked
            End If
        End With
    Next

    Cell_Checked = Success

ErrHandler:
   
    If Err.Number <> 0 Then MsgBox _
        “Cell_Checked – Error#” & Err.Number & vbCrLf & _
        Err.Description, vbCritical, “Error”, Err.HelpFile, Err.HelpContext
    On Error GoTo 0

End Function