Beyond Excel: VBA and Database Manipulation

Jul 1 2010   9:32PM GMT

Check Entry – Marking Cells as having passed or failed



Posted by: Craig Hatmaker
Tags:
database
development
excel
Microsoft Excel
ms query
odbc
sql
tutorial
vba

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      

Type Code Description
US VT Vermont
US WA Washington 
US WI Wisconsin
US WV West Virginia
US WY Wyoming
CA AB Alberta
CA BC British Columbia
CA MB Manitoba

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            

Country State/Province Date Amount
US VT 09/11/2010 10,231.00
US WA 09/11/2010 25,454.45
US WI 09/11/2010 15,132.22

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

 

 

 

 

 

 

 Comment on this Post

 
There was an error processing your information. Please try again later.
Thanks. We'll let you know when a new response is added.
Send me notifications when other members comment.

REGISTER or login:

Forgot Password?
By submitting you agree to receive email from TechTarget and its partners. If you reside outside of the United States, you consent to having your personal data transferred to and processed in the United States. Privacy

Forgot Password

No problem! Submit your e-mail address below. We'll send you an e-mail containing your password.

Your password has been sent to: