Beyond Excel: VBA and Database Manipulation


July 6, 2010  9:44 PM

Check Entry – Dealing with Field Level Exceptions



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

We’re just about finished dealing with the Check_For_Normal_Entry_Errors.  It uses one routine we haven’t discussed, Cust_Edit

Cust_Edit handles any field level validation that Check_For_Normal_Entry_Errors can’t.  Usually, this is a database lookup, but it can encompass any non-’standard’ validation – and that’s the problem with it.

Cust_Edit is really only a shell.  It is a place for you to write your own validation routines.  Many times I don’t need to modify Cust_Edit at all because the ‘standard’ edits are just fine.  Other times I have to plug in a simple database lookup for which I provide a template in the comments.  On very rare occasions, I have to write something truly unique.   Because Cust_Edit is something you modify, I can’t really explain much about it.  I can only give some guidance on how to plug your code in.  And that’s the beauty of it.

Cust_Edit is one of the few places where modifications are likely at all.  By having this shell prepared, you know exactly where to modify code, and best of all, where not to. Leave Check_For_Normal_Entry_Errors alone.  Ignore it.  Never think about it.  Put your custom validation rules in Cust_Edit only and nowhere else. 

Cust_Edit is called when V.Type (validation type) in Fields Definition Table equals “CUST” (custom) for a particular field.  The specific validation rule is held in the V.Table column.  That value is placed into sRoutine.  Plug your code after the Select Case sRoutine line.  To code the rule, create a Case Is = “<rule name>” line where “<rule name>” is the same as the value in V.Table for that field.  What you code after that is whatever is required for your particular rule.

Cust_Edit returns a comma delimited string with each value surrounded by double quotes like: “”VA”,”Virginia”" where “VA” is the code for “Virginia”.  In the templates and examples, it is assumed you want the description to display next to the code.  If you don’t, make sure only the code (surrounded by double quotes) is returned by Cust_Edit.

Since the most often case for custom validations is a database lookup, I have provided a template for that in the comments and two examples after the routine.  Copy the code for Cust_Edit into your worksheet where entries are made.  Don’t copy the examples. 

There’s one last thing I want to cover with you on this routine, and that is the odd parameter bUsePopUpbUsePopUp is a boolean (flag) variable.  If set to TRUE, Cust_Edit allows the user to select a value from the database using frmSelect.  When Cust_Edit is called from Check_For_Normal_Entry_Errors, bUsePopUp is always set to FALSE.  But Cust_Edit is also called by Set_Normal_Entry_Defaults.  We haven’t discussed Set_Normal_Entry_Defaults yet.  It is very similar to Check_For_Normal_Entry_Errors in that it can validate entries.  It is very different from Check_For_Normal_Entry_Errors in that it allows errors to be fixed.  Each routine has its place.  One cannot replace the other.   bUsePopUp allows Cust_Edit to serve them both.

Here is the code:

‘ ** Heavy modifications are likely here

 

Function Cust_Edit(sRoutine As String, rngCell As Range, _

                   bUsePopUp As Boolean) As Variant

 

   Description:Custom Validation Routine – Handles validations _

                that can’t be handled by default methods

 

   Parameters: sRoutine    Identifies the section of code to use

               rngCell     Cell being validated

               bUsePopUp   If True, user can select values from a list

 

   Example:    bResult = Cust_Edit(“Products”, Cell(lRow, 2), True)

 

     Date   Init Modification

   01/01/01 CWH  Initial Programming

 

    On Error GoTo ErrHandler   

    Cust_Edit = Null            ‘Assume the worst

       

    Dim v As Variant            ‘Generic Variant

    Dim l As Long               ‘Generic Numeric Variable

    Dim sSQL As String          ‘SQL String

    Dim sSQLCode As String      ‘SQL string for Codes/IDs

    Dim sSQLDesc As String      ‘SQL string for Descriptions/Names

    Dim sCode As String         ‘Code/ID field name

    Dim sDesc As String         ‘Desc/Name field name

    Dim sFile As String         ‘Table/File to search

   

   ‘Open the default connection

    If cn Is Nothing Then SQLConnection cn, sConnect

   

    Select Case sRoutine

       

        ‘Looking for a match in a database table/file

       

        ‘Step 1 – Look for Code’s Description in validated entries _

                  (it could only get there if code is good)

                 XL_Lookup(Range, _

                            Column in Range to return, _

                            Column to Range look in, _

                            Value to look for)

       

        ‘Step 2 – If not in worksheets, look in database

                 DB_Lookup(Value to look for, _

                            Table to look in, _

                            SQL to select Codes/IDs by, _

                            SQL to select Desc./Names by, _

                            Label for Code in frmPrompt, _

                            Label for Description in frmPrompt, _

                            Connection string, _

                            Connection Object, _

                            Popup(frmPrompt) is allowed flag)

               

                    

    End Select

 

ErrHandler:

   

    If Err.Number <> 0 Then MsgBox _

        “Cust_Edit – Error#” & Err.Number & vbCrLf & _

        Err.Description, vbCritical, “Error”, Err.HelpFile, Err.HelpContext

    On Error GoTo 0

 

End Function

 

 

 

 

 

Case Is = “Products”    ‘Access Example

    ‘Step 1 – Look for Code’s Description in validated entries

     v = XL_Lookup(Range(“Data”), “Name”, “Code”, rngCell)

     If v > “” Then v = “”"” & rngCell.Text & “”", “”" & v & “”"”

   

   ‘Step 2 – If not in worksheets, look in database

    If Left(rngCell.Text, 1) = “?” Or IsNull(v) Or IsEmpty(v) Then

        sCode = “[Product Code]“

        sDesc = “[Product Name]“

        sTable = “Products”

        sSQL = _

            “Select  Top 100 ” & sCode & “, ” & sDesc & ” ” & vbCr & _

            “From    ” & sTable & ” ” & vbCr

        sSQLCode = sSQL & _

            “Where    uCase(” & sCode & “) like ‘?%’ ” & vbCr & _

            “Order by ” & sCode & ” “

        sSQLDesc = sSQL & _

            “Where    uCase(” & sDesc & “) like ‘%?%’ ” & vbCr & _

            “Order by ” & sDesc & ” “

        v = DB_Lookup(rngCell.Text, sSQLCode, sSQLDesc, _

                      “Code”, “Name”, bUsePopUp, sConnect, cn)

    End If

    If Not IsNull(v) And Not IsEmpty(v) Then Cust_Edit = v

       

Case Is = “CUSTMAST”    ‘DB2 Example

    ‘Step 1 – Look for Code’s Description in validated entries

     v = XL_Lookup(Range(“Data”), “Name”, “Code”, rngCell)

     If v > “” Then v = “”"” & rngCell.Text & “”", “”" & v & “”"”

   

   ‘Step 2 – If not in worksheets, look in database

    If Left(rngCell.Text, 1) = “?” Or IsNull(v) Or IsEmpty(v) Then

        sCode = “CUCODE”

        sDesc = “CUNAME”

        sTable = “CUSTMAST”

        sSQL = _

            “Select  ” & sCode & “, ” & sDesc & ” ” & vbCr & _

            “From    ” & sTable & ” ” & vbCr

        sSQLCode = sSQL & _

            “Where    uCase(” & sCode & “) like ‘?%’ ” & vbCr & _

            “Order by ” & sCode & ” ” & vbCr & _

            “Fetch First 100 Rows Only “

        sSQLDesc = sSQL & _

            “Where    uCase(” & sDesc & “) like ‘%?%’ ” & vbCr & _

            “Order by ” & sDesc & ” ” & vbCr & _

            “Fetch First 100 Rows Only “

        v = DB_Lookup(rngCell.Text, sSQLCode, sSQLDesc, _

                      “Code”, “Name”, bUsePopUp, sConnect, cn)

    End If

    If Not IsNull(v) And Not IsEmpty(v) Then Cust_Edit = v

 

 

 

 

 

 

 

 

 

 

 

July 1, 2010  9:32 PM

Check Entry – Marking Cells as having passed or failed



Posted by: Craig Hatmaker
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

 

 

 

 

 

 


June 30, 2010  9:30 PM

Check Entry – Common Validations



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

Today’s post is about a routine I call Check_For_Normal_Entry_Errors.  In my opinion, the toughest part of coding is checking for entry errors because just knowing what good values look like isn’t good enough.  You also need to anticipate anything a user might do even though it may make no sense for anyone to do whatever that might be.  If you’ve been coding end user entry applications for any length of time, you know exactly what I mean.  I’m not going to tell you that I’ve solved that riddle, but I do offer some basic validation routines that fit many common entry problems.  I also offer the source code so you can fill in the gaps I have left.

Check_For_Normal_Entry_Errors is meant to be a function that is never modified for a specific entry problem.  It is for ‘general’ entry problems and for that reason is placed in modTableUpdateCheck_For_Normal_Entry_Errors works in concert with Check_Entry which is a routine meant to be modified for a particular worksheet’s specific validation needs.  That routine may have to be modified often; but, not everytime.  In the example we are building, we won’t need to modify it.  Check_For_Normal_Entry_Errors handles everything we need.

Check_For_Normal_Entry_Errors receives a cell and finds which validation rule should  be applied to it from the Fields Definition table discussed in several prior posts.  The rules that can be specified in the Fields Definition table that Check_For_Normal_Entry_Errors can apply to the cell are to make sure:

  • Required entries are not empty
  • The ACD column only contains the values “A”, “C”, “D”, or “X” (Add, Change, Delete or eXisting)
  • Date fields contain valid dates (NOTE: This does not check to make sure dates are future or past, workdays or not, etc.)
  • Flag fields contain “Y” or “N” (Yes or No)
  • Numeric fields contain numbers only
  • Code fields are limited to values in an Excel Code Table
  • Type Code Fields are limited to values that match a “Type” value in the entry and a “Code” value in an Excel Type Table
  • Text fields are limited to a designated number of characters
  • Custom Edits/Validations are handled by the worksheet’s Check_Entry routine

There are a few support routines here that I have not yet covered.  They are small routines that mark cells in error or as having passed our validation rules.  Those will be the subject of our next post.

One last note, this routine will never, and should never try to correct anything.  ALL this routine does is determine if an entry is valid or not.  Now that may seem odd because I spent so much time on frmSelect which is all about helping users correct bad entries.   I included frmSelect because it is called by routines Check_For_Normal_Entry_Errors uses, but Check_For_Normal_Entry_Errors tells those routines to NOT use frmSelect for that purpose.  Those routines serve multiple masters and when they serve Set_Entry_Defaults, frmSelect will come into play.  Just keep in mind that there are times when you want to let the user know their entry is wrong and help them fix it, and times when ALL you want to know is if the entry is ready for posting.  Those functions have a lot of overlap, but they MUST be independent of each other.

As always, I believe the code’s documentation explains how the routines works so I’ll not duplicate what’s in the code.  Here is the code. 

Function Check_For_Normal_Entry_Errors( _
		sWorksheet As String, sFields As String, lField As Long, _
                  rngCell As Range, rngMsg As Range) As Boolean
'   Description:Checks a cell against the most common validation rules.
'               Place special rules in Worksheet's Check_Entry routine
'   Parameters: sWorksheet  Worksheet containing data AND Check_Entry routine
'               sFields     Range name containing field descriptions
'               lField      Relative row (-1) within sFields of field to check
'               rngCell     Cell being checked
'               rngMsg      Cell in which to put any error messages
                           
'   Example:    bResult = Check_For_Normal_Entry_Errors( _
                              Me.Name, sDetailFields, _
                              lCol - lColData + 1, _
                              Cells(lRow, lCol), _
                              Cells(lRow, lColNote))
'     Date   Init Modification
'   01/12/06 CWH  Initial Programming
    On Error GoTo ErrHandler           
    Check_For_Normal_Entry_Errors = Success     'Assume the best
       
    Dim s As String     'Generic String Variable
    Dim t As String     'Type for a code
    Dim v As Variant    'Generic Variant Result
      
    lField = lField + 1
    With Range(sFields)
   
        If UCase(.Cells(lField, lColReq)) = "Y" And Trim(rngCell) <= "" Then
            Cell_Error rngCell, rngMsg, .Cells(lField, lColHdg) & _
                " is required"
            Check_For_Normal_Entry_Errors = Failure
       
        ElseIf Trim(rngCell) > "" Then
       
            Select Case UCase(.Cells(lField, lColVTyp))
           
               'eXisting, Added, Changed, Deleted record indicator
                Case "ACD"
                    If InStr(1, "ACDX", rngCell) <> 0 Then
                        Cell_Checked rngCell
                    Else
                        Cell_Error rngCell, rngMsg, .Cells(lField, lColHdg) & _
                            "In ACD: A=Add, C=Change or D=Delete"
                        Check_For_Normal_Entry_Errors = Failure
                    End If
               
               'Dates
                Case Is = "DATE"
                    If IsDate(rngCell) Then
                        Cell_Checked rngCell
                    Else
                        Cell_Error rngCell, rngMsg, .Cells(lField, lColHdg) & _
                            " must be a valid date and time"
                        Check_For_Normal_Entry_Errors = Failure
                    End If
                   
               'Yes or No flags
                Case Is = "YORN"
                    If InStr(1, "YyNn", rngCell) <> 0 Then
                        Cell_Checked rngCell
                    Else
                        Cell_Error rngCell, rngMsg, .Cells(lField, lColHdg) & _
                            " must be Y (Yes) or N (No)"
                        Check_For_Normal_Entry_Errors = Failure
                    End If
               
               'Numeric Values
                Case Is = "#", "$", "NUMBER"
                    If IsNumeric(rngCell) Then
                        Cell_Checked rngCell
                    Else
                        Cell_Error rngCell, rngMsg, .Cells(lField, lColHdg) & _
                            " must be numeric"
                        Check_For_Normal_Entry_Errors = Failure
                    End If
               
               'Custom Edits/Validation rules
                Case Is = "CUST"                   
                    s = .Cells(lField, lColVTbl)    'Get rule Name
                    v = Worksheets(sWorksheet).Cust_Edit(s, rngCell, False)
                    If Not IsNull(v) Then
                        Parse_SQL_Result CStr(v), rngCell.Row, rngCell.Column
                        Cell_Checked rngCell
                    Else
                        Cell_Error rngCell, rngMsg, .Cells(lField, lColHdg) & _
                            " is not valid"
                        Check_For_Normal_Entry_Errors = Failure
                    End If
               
               'Excel Code Tables
                Case Is = "XLC"
                    s = .Cells(lField, lColVTbl)    'Get XL Table Name
                    v = XL_Lookup(Range(s), "Code", "Code", rngCell.Text)
                    If Not IsNull(v) Then
                        Cell_Checked rngCell
                    Else
                        Cell_Error rngCell, rngMsg, .Cells(lField, lColHdg) & _
                            " is not valid"
                        Check_For_Normal_Entry_Errors = Failure
                    End If
               
               'Excel Type Tables
                Case Is = "XLT"
                   'Excel Table holding Types and Codes

                    s = .Cells(lField, lColVTbl)       
                   'The Type value within the Entry to restrict codes by                    
                    t = Cells(rngCell.Row, Fields_Field_Column(sFields, s))
                    s = Trim(Left(s, InStr(1, s, "{") - 1))                
                    v = XL_Lookup(Range(s), "Code", "Code", _
                                  rngCell.Text, "Type", t)
                    If Not IsNull(v) Then
                        Cell_Checked rngCell
                    Else
                        Cell_Error rngCell, rngMsg, _
                            .Cells(lField, lColHdg) & _
                            " is not valid for code " & rngCell.Cells(1, 0)
                        Check_For_Normal_Entry_Errors = Failure
                    End If
                               
               'Limits on the number of characters in a text field
                Case Else
                    v = Val(.Cells(lField, lColVTyp))
                    If v > 1 Then
                        If Len(rngCell) <= v Then
                            Cell_Checked rngCell
                        Else
                            Cell_Error rngCell, rngMsg, _
                                .Cells(lField, lColHdg) & _
                                " must be " & v & "characters or less"
                            Check_For_Normal_Entry_Errors = Failure
                        End If
                    End If
                   
            End Select
        End If
    End With
ErrHandler:
   
    If Err.Number <> 0 Then
        Check_For_Normal_Entry_Errors = Failure
        Cell_Error rngCell, rngMsg, rngCell.Cells(lField, lColHdg) & _
             Err.Description
        MsgBox _
            "Check_For_Normal_Entry_Errors - Error#" & Err.Number & vbCrLf _
             & Err.Description, vbCritical, "Error", Err.HelpFile, _
             Err.HelpContext
        End If
    On Error GoTo 0
End Function


June 25, 2010  3:54 PM

Check Entry – Form Select – Code



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

Today we add the code to frmSelect (See: frmSelect Visual Elements for what this form looks like, or frmSelect Theory to see how it works).  This code must be added to the form.  If you’re not sure how to do that, watch the video in frmSelect Visual Elements and at the tale end is where, in the Project Explorer you’ll see me right clicking on frmSelect and left clicking on “View Code.”  In the Code View Window is where you paste all the code provided. 

There’s a good bit of code but all you have to do is copy and paste it (with perhaps a tweak or two because this blog doesn’t always paste code nicely into the VBE).  And the really good news is that once you’ve saved this form, you’ll never have to change it again.  It has worked well over all master files or code files I’ve seen without any modifications. 

When finished, be sure to save your work.  You may also want to save the form as a separate object so you can import it into other Excel spreadsheets easily.  To export the form, in the Project Explorer right click on frmSelect and left clicked on “Export File…”  Here is the code:

 

Option Explicit

'   Name:   frmSelect
'   Purpose:Help user pick something by Code/ID/# or Description
'     Date   Init Modification
'   01/12/06 CWH  Initial Programming
'   Examples:
'   Pick State from an XL "Code" table
'   vResult = frmSelect.Pick_Code("States")
'   Pick Account from an XL "Type" table
'   vResult = frmSelect.Pick_Type("Accounts", "Credit")
'   See Methods Pick_Code and Pick_Type at the end of this form. _
    These can be used as is or copied and customized in a module
'   Set (Write Only) Property Variables
    Dim sConnect As String  'See property pConnect
    Dim sSQLCode As String  'See property pSQLCode
    Dim sSQLDesc As String  'See property pSQLDesc
   
    Dim sDesc As String     'See property pDftDesc
    Dim sCode As String     'See property pDftCode
   
'   Get(Read Only) Property Variables
    Dim bOK As Boolean      'See property pOK
'Begin Properties
'   Title Bar Text (Optional)
Public Property Let pTitle(sString As String)
    Me.Caption = sString
End Property
'   Connect - ODBC connection string (Required)
Public Property Let pConnect(sString As String)
    sConnect = sString
End Property
'   Code: These properties relate to the "Code" value
Public Property Let pCode(sString As String)    'Set value
    sCode = sString
End Property
Public Property Get pCode() As String           'Get value
    pCode = sCode
End Property
Public Property Let pLblCode(sString As String) 'Label for entry box
    lblCode.Caption = sString
End Property
Public Property Let pDftCode(sString As String) 'Default value
    txtCode.Text = sString
End Property
Public Property Let pSQLCode(sString As String) 'SQL Search String
'   The String must contain a valid SQL select statement with a "?"
'   to indicate where to substitute the txtID.text
    sSQLCode = sString
End Property
'   Description: These properties relate to teh "Description" value
Public Property Let pDesc(sString As String)    'Set value
    sDesc = sString
End Property
Public Property Get pDesc() As String           'Get value
    pDesc = sDesc
End Property
Public Property Let pLblDesc(sString As String) 'Label for entry box
    lblDesc.Caption = sString
End Property
Public Property Let pDftDesc(sString As String) 'Default value
    txtDesc.Text = sString
End Property
Public Property Let pSQLDesc(sString As String) 'SQL search string
'   The String must contain a valid SQL select statement with a "?"
'   to indicate where to substitute the txtDesc.text
    sSQLDesc = sString
End Property
'   True if the OK button was clicked
Public Property Get pOK() As Boolean
    pOK = bOK
End Property
 
'Begin Event Handlers
'   Exit Button
Private Sub cmdExit_Click() 'Exit Click
    Me.Hide
End Sub
'   OK Button
Private Sub cmdOK_Click()   'OK Click
    Dim i As Integer
    Dim sSQL As String
    Dim bfound As Boolean
   
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
   
    Dim iTimeOut As Integer
   
    Dim errLoop As Error
   
'   Initialize variables used in this routine
    sSQL = ""
      
'   If the user changed the ID then create the SQL search string
    If txtCode <> sCode Then
        bfound = False
        If lstList.Visible Then
            For i = 0 To lstList.ListCount - 1
                If Trim(UCase(txtCode)) = _
                   Trim(UCase(lstList.List(i, 0))) Then
                    lstList.ListIndex = i
                    bfound = True
                    Exit For
                End If
            Next i
        End If
        If Not bfound Then
            sCode = txtCode
            txtDesc = ""
            sDesc = ""
            sSQL = InsertSQLVariable(sSQLCode, Trim(UCase(sCode)))
            txtCode.SetFocus
        End If
    End If
'   If user changed Description then create  SQL search string _
    (this overrides ID changes)
    If txtDesc <> sDesc Then
        sDesc = txtDesc
        txtCode = ""
        sCode = ""
        sSQL = InsertSQLVariable(sSQLDesc, Trim(UCase(sDesc)))
        txtDesc.SetFocus
    End If
'   If an SQL string was created above then search database
    If sSQL > "" Then
   
        Debug.Print "Start:", Time, sSQL
       
        Set cn = New ADODB.Connection
        cn.Properties("Prompt") = adPromptComplete
        cn.Open sConnect, "", ""
        Set rs = New ADODB.Recordset
       
        If iTimeOut > 0 Then
            cn.CommandTimeout = iTimeOut
        End If
   
        rs.Open sSQL, cn
   
        Debug.Print "End:", Time
        lstList.Clear
        If rs.EOF Then
            lblMessage = "No records found"
        Else
            lblMessage = ""
            rs.MoveFirst
            i = 0
            Do While Not rs.EOF
                lstList.AddItem rs(0)
                lstList.List(i, 1) = IIf(IsNull(rs(1)), " ", rs(1))
                rs.MoveNext
                i = i + 1
            Loop
            lstList.Visible = True
            lstList.SetFocus
        End If
        rs.Close
        cn.Close
       
'   If no SQL string was created (because user didn't change anything) _
    then did user select anything?
    Else
'       If anything was selected, were done!
        If lstList.Visible And lstList.Value > "" Then
            sCode = lstList.Value
            sDesc = lstList.List(lstList.ListIndex, 1)
            bOK = True
            Me.Hide
        End If
       
    End If
               
    On Error GoTo 0
    Exit Sub
   
ErrHandler:
               
    If cn.Errors.Count = 0 Then
        MsgBox "cmdOK_Click Error#" & Err.Number & vbCrLf & Err.Description, _
            vbCritical, "Error in cmdOK_Click", Err.HelpFile, Err.HelpContext
    Else
        For i = 0 To cn.Errors.Count - 1
            MsgBox "Error number: " & cn.Errors(i).Number & vbCr & _
               cn.Errors(i).Description, vbCritical, "Error in cmdOK_Click", _
               cn.Errors(i).HelpFile, cn.Errors(i).HelpContext
        Next i
    End If
       
    rs.Close
    cn.Close
  
End Sub
'   Double click on list selects the code and exits
Private Sub lstList_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    sCode = lstList.Value
    txtCode = sCode
    cmdOK_Click
End Sub
'   Activate form
Private Sub UserForm_Activate()
   'Center form on screen
    Me.Left = Application.Left + Application.Width / 2 - Me.Width / 2
    bOK = False		'Assume the worst
    lstList.Visible = False
   'Set Column Widths of lstList to match the input text boxes
    lstList.ColumnWidths = txtCode.Width & ";" & txtDesc.Width
    sCode = ""		'Clear Text Boxes
    sDesc = ""
   'Give the users some instructions
    lblMessage = "Wildcard characters: '_'(underscore) " & _
                 "replaces just 1 character  '%' replaces many"
    cmdOK_Click		'List whatever is possible to list
End Sub
 
'Begin Functions
'   Replaces a "?" in an SQL string with something else
Private Function InsertSQLVariable(sSQL As String, sVariable As String)
    Dim i As Integer        'Generic integer
   
    i = InStr(1, sSQL, "?")
    InsertSQLVariable = Left(sSQL, i - 1) & sVariable & _
                        Right(sSQL, Len(sSQL) - i)
End Function
 
'   Pick a code from an Excel code table in the active spreadsheet
'   Table must have two columns: Code and Description
'   Where:
'       Code        unique identifier (ex. "VA" or "MD")
'       Description expanded text for the Code (ex. "Virginia" or "Maryland")
Public Function Pick_Code(sCodeTable As String) As Variant
  
   Pick_Code = Null
  
   With frmSelect
        .pConnect = _
            "DBQ=" & ActiveWorkbook.Path & "\" & ActiveWorkbook.Name & ";" & _
            "Driver={Microsoft Excel Driver (*.xls)};"
        .pLblCode = "Code"
        .pLblDesc = "Description"
        .pTitle = "Select Code from " & sCodeTable
        .pCode = ""
        .pDftCode = " "
        .pSQLCode = _
            "Select T.Code as CODE, T.Description as NAME " & _
            "From " & sCodeTable & " T " & _
            "Where Ucase(T.Code) Like '?%' " & _
            "Order by T.Code "
        .pSQLDesc = _
            "Select T.Code as CODE, T.Description as NAME " & _
            "From " & sCodeTable & " T " & _
            "Where Ucase(T.Description) Like '%?%' " & _
            "Order by T.Description "
        .Show
        Do While .Visible
            DoEvents
        Loop
        If .pOK Then   'The OK button was used to exit
            Pick_Code = .pCode
        End If
   End With
End Function
 
'   Pick a Type from an Excel code table in the active spreadsheet
'   Table must have three columns: Code, Type, & Description
'   Where:
'       Type        Major catagory (Country ex. "USA" or "Mexico")
'       Code        Individual element (State w/in Coutnry ex. "VA", or "MD")
'       Description Expanded text for Code (ex. "Virginia" or "Maryland")
Public Function Pick_Type(sCodeTable As String, sType As String) As Variant
  
   Pick_Type = Null
  
    With frmSelect
        .pConnect = _
            "DBQ=" & ActiveWorkbook.Path & "\" & ActiveWorkbook.Name & ";" & _
            "Driver={Microsoft Excel Driver (*.xls)};"
        .pLblCode = "Code"
        .pLblDesc = "Description"
        .pTitle = "Select Code of Type " & Trim(sType) & " from " & sCodeTable
        .pCode = ""
        .pDftCode = " "
        .pSQLCode = _
            "Select T.Code as CODE, T.Description as NAME " & _
            "From " & sCodeTable & " T " & _
            "Where Ucase(T.Code) Like '?%' " & _
            "  And Ucase(T.Type) = '" & UCase(sType) & "' " & _
            "Order by T.Code "
        .pSQLDesc = _
            "Select T.Code as CODE, T.Description as NAME " & _
            "From " & sCodeTable & " T " & _
            "Where Ucase(T.Description) Like '%?%' " & _
            "  And Ucase(T.Type) = '" & UCase(sType) & "' " & _
            "Order by T.Description "
      .Show
       Do While .Visible
           DoEvents
       Loop
       If .pOK Then   'The OK button was used to exit
            Pick_Type = .pCode
       End If
   End With
End Function


June 23, 2010  5:43 PM

Check Entry – Form Select – Visual Elements



Posted by: Craig Hatmaker
database, development, excel, Microsoft Excel, ms query, odbc, sql, tutorial, vba
Today we will see how frmSelect is constructed.  This is the basic form with the visual elements labeled.
frmSelect with Labels

frmSelect with Labels

And here is a video that shows how to assemble these elements.
[kml_flashembed movie="http://www.youtube.com/v/TN0sLLPjcuQ" width="578" height="476" wmode="transparent" /]
Now it took a bit of time to create the video so please be understanding as to why this post is so short in terms of words.   In the next post we will wire this up.


June 19, 2010  11:25 AM

Check Entry – Form Select – Theory and Demo



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

frmSelect facilitates finding and selecting a record in massive lists by allowing the user to search by code/id/number or description/name (See video demo at bottom of post).  Below is a screen shot showing someone searching a poorly designed customer master file.  It looks and functions similar to another form I introduced months ago called frmSelect_Mulitple.  This differs in that frmSelect only permits a single item to be selected. Selecting multiple codes makes sense when you want to filter a database and expect several records to be returned.  It does not make sense when only a single item can be entered into a single field/column of a single record/row of a database file/table.  So where as frmSelect_Multiple was introduced in the context of reporting, frmSelect is introduced in the context of data entry.

frmSelect Sample

frmSelect Sample

Data entry often requires things like Country Codes, Employee IDs, Account Numbers, Customer IDs, Project Numbers, Status Codes, Contact IDs, etc.  Excel natively provides means to select such items in drop down list boxes or combo list boxes.  Those work great for small lists.  They really don’t work for massive lists.  So before we explain why, allow me a moment to talk about business databases in general.

In my years as a business developer, I classified four major types of file structures, three of which I’ll discuss here:

  • Transaction Files/Tables – These files contain things like purchase orders, invoices, checks, manifests, etc.  They are usually divided up into a Header File/Table and a Detail File/Table.  
     
    Header Files: These files contain transaction attributes for which there can be only one item associated to the transaction.  Using an Invoice as an example, an Invoice can be for 1 and only 1 customer.  It is issued on 1 and only 1 date.  It has 1 and only 1 Invoice number.  In this case, the invoice number should be the primary key.
     
    Detail Files: These files contain the many to 1 relationships.  Using the Invoice as an example: there can be many items on 1 Invoice; there can be mutliple charges on 1 Invoice; there can be multiple accounts associated with 1 Invoice.  In general, these files are keyed with the Header File’s primary key and a Line Item number.
     
  • Master Files/Tables – These files contain things like people, places or things.  They include Employee Masters, Customer Masters, Inventory Masters, etc.  Master files, in my experience, all share something in common.  They all have a Primary key field, and they all have a description field
     
    Primary Key Field: Primary Key Fields are unique identifiers that never, ever change.  Good primary keys for master files are ALWAYS numbers assigned by the system that have NO meaning what-so-ever associated with the contents of the record (The non-numeric abbreviation as the key to the customer master in the screen shot makes that file poorly designed in my opinion).Primary Key Fields are ONLY a means to uniquely identify a Master File record. Because master file primary keys never change, they are what should be stored in Transaction Files.  An example might be an Employee ID from the Employee Master which must be recorded in the Payroll Checks Transaction File so we know who the check was for.  We always want the key field and never the employee’s name because the name might change such as when an employee is married and that would orphan child records.
     
    Description Fields: Descriptions are what we, as humans, know people, places, and things by.  For example, we know Fred Jones by his name, not his Employee Number.  It’s possible there are two “Fred Jones” employeed at my company, but each one will have a unique employee number.  For this reason, we must be able to find master file records by the description (what we know), and use the primary key field (guaranteed unique and unchanging) to identify a specific record.
     
  • Code Files – These files are very similar to Master Files except the primary key has meaning.  It’s usually an abbreviation that was accepted by convention.  An example is “USA” as the code for “United States of America”.  Another example is a General Ledger’s Chart of Accounts which uses a highly coded account number as the primary key.   Like master files, the primary key must be guaranteed unique and unchanging.  Unlike master files, we sometimes know the abbreviation as well or better than the name or description.

Excel’s list boxes facilitate “begins with” searching of only one field in a list and, for small lists, they are faster.  frmSelect facilitates “begins with” and “contains” searching of the primary key and description fields and, for massive lists stored on a server, frmSelect is overall faster.  Since both Master Files and Code Files have a primary key and a description, frmSelect works nicely for both. 

The YouTube video below shows frmSelect in action.  We’ll see how to construct frmSelect in the next post.

[kml_flashembed movie="http://www.youtube.com/v/RP9AxFYHBAg" width="578" height="476" wmode="transparent" /]


June 17, 2010  4:37 PM

Check Entry – DB_Lookup



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

DB_Lookup validates a code or ID against a database table.   Where as XL_Lookup is meant for tiny code lists, such as States or Provinces that fit nicely in an Excel range, DB_Lookup is meant for massive lists such as employees, customers, or general ledger account numbers.  Mere mortals such as we stuggle to memorize such volumes of data and so a means to search such lists using partial codes or descriptions is often a necessity.

Because this is often used over massive lists, I recommend adding a limiter to your SQL Select statements, such as the “Top 99″ bit shown in the example’s documentation below.  Unfortunately, “Top 99″ isn’t standard ISO.2008 SQL.  It works fine for our Access database, but Access doesn’t accept the standard “Fetch Top 99 Rows Only”.  This means you may have to adjust your SQL statements a bit depending on which database you use.  To help you find which syntax is best, here is a helpful link: http://en.wikipedia.org/wiki/Select_(SQL)#FETCH_FIRST_clause

Search capabilities are welcome user tools and so it may seem unfair that XL_Lookup doesn’t offer them for the tiny lists in Excel ranges.  That’s okay.  If you really want to add such capabilities to Excel ranges, you can. DB_Lookup works with Excel’s ranges since Excel’s ranges can be searched by ODBC just like most relational databases. 

There are times, however, when we don’t want to offer DB_Lookup‘s search capabilities and so, we have a switch that allows us to turn that feature off, bUsePopUp.  If bUsePopUp is set to false, the user will not be given the opportunity to select a valid entry;  DB_Lookup will just verify the code or ID.  This is useful when we want to perform a final check of all entries just before updating the database and we only want to know if everything is OK.  If it isn’t, the user will get their chance to fix things later.

DB_Lookup can connect to the database by creating its own private connection from a connection string, or by sharing an already existing connection object.  I recommend using a connection object for speed in most cases, especially when checking scores of entries just before updating the database. 

Lastly, I want to mention the vbTextCompare constant in our Replace statement in the code below.  vbTextCompare  makes our Replace statement case insensitive so I don’t have to worry if “like” in sSQLCode string was all lower case, all upper case, or mixed case.

Here is DB_Lookup.  Next post will cover frmSelect.

Function DB_Lookup(sCode As String, _
                   sSQLCode As String, sSQLDesc As String, _
                   sCodeLbl As String, sDescLbl As String, _
                   bUsePopUp As Boolean, sConnect As String, _
                   Optional cn As ADODB.Connection _
                   ) As Variant
'   Description:Validates that a value exists in a database table
'   Parameters: sCode       Code/ID/Number to be validated
'               sSQLCode    SQL to find records by Codes/ID/Numbers
'               sSQLCode    SQL to find records by Description/Names
'               sCodeLbl    Label for Code in frmSelect
'               sDescLbl    Label for Desc in frmSelect
'               bUsePopUp   If true, let user select sCode
'               sConnect    Connection String
'               cn          Connection Object (optional)
'   Example:    sSQLCode = _
'                   "Select   Top 99 [Product Code],[Product Name] " & _
'                   "From     Products " & _
'                   "Where    uCase([Product Code]) like '?%' " & _
'                   "Order by [Product Code] "
'               sSQLDesc = _
'                   "Select   Top 99 [Product Code],[Product Name] " & _
'                   "From     Products " & _
'                   "Where    uCase([Product Name]) like '%?%' "& _
'                   "Order by [Product Name] "
'               v = DB_Lookup(rngCell.Text, "Products", _
'                             sSQLCode, sSQLDesc, _
'                             "Code", "Name", True, sConnect, cn)
'     Date   Init Modification
'   01/01/01 CWH  Initial Programming
    On Error GoTo ErrHandler        '
    DB_Lookup = Null                'Assume the worst
       
    Dim v As Variant                'Generic Result
    Dim sSQL As String              'SQL string
           
   'Step 1: Just see if it is in the file
   '        Use the sSQLCode string to construct an _
            SQL Select statement without wildcards or _
            the "like" keyword (use "=" instead)
    sSQL = Replace( _
                Replace( _
                    Replace(sSQLCode, "%", ""), _
                    "?", sCode), _
                " LIKE ", " = ", 1, -1, vbTextCompare)
    v = SQLRead(sSQL, sConnect, 300, False, cn)
   
   'Step 2: If not, ask user to select (if allowed)
    If IsNull(v) Or IsEmpty(v) Or v = "" Or v = Failure Then
        If bUsePopUp Then
            With frmSelect
                .pConnect = sConnect
                .pLblCode = sCodeLbl
                .pLblDesc = sDescLbl
                .pTitle = "Select " & sCodeLbl
                .pCode = ""
                .pDftCode = Replace(sCode, "?", "") & "%"
                .pSQLCode = sSQLCode
                .pSQLDesc = sSQLDesc
                .Show
                Do While .Visible
                    DoEvents
                Loop
                If .pOK Then   'The OK button was used to exit
                   DB_Lookup = """" & .pCode & """,""" & .pDesc & """"
                End If
           End With
       End If
   Else
       DB_Lookup = v
   End If
ErrHandler:
   
    If Err.Number <> 0 Then MsgBox _
        "DB_Lookup - Error#" & Err.Number & vbCrLf & Err.Description, _
        vbCritical, "Error", Err.HelpFile, Err.HelpContext
    On Error GoTo 0
End Function


June 12, 2010  11:12 PM

Check Entry – XL_Lookup & Dynamic Arguments



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

Creating that last post ate at me.  The old Table_Lookup functions just seemed so klunky that I was ashamed to have posted them.  So I rolled up my sleeves and did what I should have done long ago.  I created a function that:

  • Gets a result from an Excel range like VLOOKUP, but with more than just one key.
  • Accepts any number of key values – not just three like Table_Lookup.
  • Accepts column headings like Table_Lookup_By_Name for ease of use – OR -
  • Accepts relative column numbers like Table_Lookup when speed is more important.

With this post I introduce a function that handles an unknown number of arguments/parameters so I’ll spend a little time explaining how this is done. 

Below is the code for our new function XL_Lookup.  In XL_Lookup‘s declaration is a keyword ParamArray.

(From: Microsoft’s documentation) The ParamArray keyword indicates that a procedure argument is an optional array of elements of the specified type. ParamArray can be used only on the last argument of an argument list. It allows you to pass an arbitrary number of arguments to the procedure. A ParamArray argument is always passed using ByVal.

ParamArray is the only way I know to create user defined functions (UDFs) that have a variable number of values passed from Excel without using a range object.  We can also use UDFs within VBA.  UDFs that use ParamArray can be called within VBA with either a list of values (just as they are called from Excel) or the values placed neatly into an array. 

ParamArray basically takes any arguments/parameters to the right of the ParamArray keyword and stuffs them into an array with only 1 dimension.  Since the argument/parameter is an array, you can determine the number of arguments/parameters sent by using the UBound function.

Public Function XL_Lookup(Table As Variant, ResultColumn As Variant, _
                          ParamArray Keys() As Variant) As Variant

‘   Description:Vlookup with multiple key values (no limit) 

‘   Parameters:
‘       Data            Range with keys and values
‘       ResultColumn    Result’s relative column # or heading
‘                       NOTE: Column #s are faster
‘                       NOTE: If vResultColumn is a #, it is
‘                             assumed to be a column #, NOT a
‘                             column heading.
‘       Keys(Odd)       Column #s or Headings holding key values
‘                       NOTE: To speed things up, use the column
‘                             that is most likely to be unique first
‘       Keys(Odd+1)     Key value for vKeys(Odd) 

‘   Example:    This retrieves the cell in the column labeled

‘               “Budget Amount” from an XL range called “Data”
‘               where a row contains:
‘                   “Hardware” under column labeled “Budget Item” &
‘                   “SAP” under column labeled “Project” &
‘                   “Capital” under column labeled “Expense Type” 

‘               vResult = XL_Lookup(Range(“Data”), “Budget Amount”, _
‘                                   “Budget Item”, “Hardware”, _
‘                                   “Project”, “SAP”, _
‘                                   “Expense Type”, “Capital”)
‘               If not isNull(vResult) then cAmount = cCur(vResult) 

‘               This function also works directly in Excel as:
‘               =XL_Lookup(A1:G:99, “Budget Amount”,
‘                          “Budget Item”, “Hardware”, _
‘                          “Project”, “SAP”, _
‘                          “Expense Type”, “Capital”) 

‘     Date   Init Modification
‘   06/12/10 CWH  Initial Programming

     On Error GoTo ErrHandler

    XL_Lookup = Null            ‘Assume not found 

    Dim c As Range
    Dim LastAddress As String
    Dim lKeyCols() As Long      ‘Key Column Numbers
    Dim vKeyVals() As Variant   ‘Key Values
    Dim lResultCol As Long      ‘Result Column Number
    Dim iElements As Integer    ‘Number of Elements in Array
    Dim i As Integer            ‘Generic Counter
    Dim n As Integer            ‘Generic Counter
    Dim bMatch As Boolean       ‘Match found Flag

    Dim lRow As Long
 
  Dim lRows As Long 

‘   Work with a range object
    Dim Data As Range
    Set Data = CRange(Table)
    If Data Is Nothing Then Exit Function    

‘   Determine Result Column
    lResultCol = IIf(IsNumeric(ResultColumn), _
                     ResultColumn, _
                     FieldColumn(CStr(ResultColumn), Data))
    If lResultCol = 0 Then Exit Function   

‘   Determine Key Columns
    iElements = ((UBound(Keys, 1) + 1) / 2) – 1
    n = 0

    ReDim lKeyCols(iElements)
    ReDim vKeyVals(iElements)

    For n = 0 To iElements
        i = n * 2
        If IsNumeric(Keys(i)) Then
            lKeyCols(n) = Keys(i)
        Else
            lKeyCols(n) = FieldColumn(CStr(Keys(i)), Data)
        End If
        vKeyVals(n) = Keys(i + 1)
    Next n   

    lRow = 1
    lRows = Data.Rows.Count
    LastAddress = “”
    Set c = Data.Columns(lKeyCols(0)).Cells(1, 1)

    Do

‘       Position to first/next possible candidate
        Set c = Data.Columns(lKeyCols(0)).Find( _
                    What:=vKeyVals(0), After:=c, LookIn:=xlValues, _
                    LookAt:=xlWhole, MatchCase:=False)

‘       If we didn’t get anything then exit function
        If c Is Nothing Then Exit Function
        If c.Address = LastAddress Then Exit Function

‘       Make sure all other key values match
        bMatch = True               ‘Assume the rest is good

        LastAddress = c.Address
        lRow = c.Row – Data.Row + 1
        For i = 1 To iElements
            If UCase(vKeyVals(i)) <> _
               UCase(Data.Cells(lRow, lKeyCols(i))) Then
                bMatch = False      ‘Assumption was bad
                Exit For
            End If
        Next i

‘       All matched. Exit with results
        If bMatch Then
            XL_Lookup = Data.Cells(lRow, lResultCol)
            Exit Function
        End If

‘   Something didn’t match.  Look again.
    Loop

ErrHandler:   

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

End Function

 

Public Function CRange(ByRef Data As Variant) As Range

‘   Description:Make sure “Data” is a Range object
‘               This routine provides backward compatibility for older
‘               routines and facilitates polymorphism for new routines

‘   Parameters: Data    Either a range name or range object

‘   Example:    Set rngRange = CRange(Table)

‘     Date   Ini Modification
‘   11/20/10 CWH Initial Programming
‘   03/14/11 CWH Added conversion of Table to Range

    On Error Resume Next

    Set CRange = Nothing     ‘Assume the Worst      

    Select Case TypeName(Data)
        Case Is = “Range”
            Set cRange = Data
        Case Is = “Worksheet”
            Set cRange = Data.UsedRange
        Case Is = “String”
            Dim lo As ListObject
            If TableExists(CStr(Data), lo) Then
                Set cRange = lo.Range
            Else
                Set cRange = Range(Data)
            End If
        Case Is = “ListObject”
            Set cRange = Data.Range
    End Select

    On Error GoTo 0

 End Function


June 2, 2010  9:27 PM

Check Entry – Table Lookup



Posted by: Craig Hatmaker
database, development, excel, Microsoft Excel, ms query, odbc, sql, tutorial, vba
You are here (Click to enlarge)

You are here (Click to enlarge)

One of the most common data validations methods is simple confirmation that a value exists in another table.  If the data is in an Excel range, then VLOOKUP might be just what you want.  Then again, it might not.  Suppose you want a simple spreadsheet in which you log your time against projects assigned to you.   Naturally, the data validation routine should check to make sure you only enter project IDs assigned to you and no-one else.  That is a requirement VLOOKUP can’t handle very well.

As a result I created a routine that can check just one key like VLOOKUP, or two or three.  Actually, I created two routines.  This is a case of program evolution.  My first routine used column numbers to identify columns to search instead of column headers.  Column headers are much easier to understand for us humans.  So as things went on, I decided to wrap the first routine in a routine that translated column headers into column numbers before calling the original routine. 

Here is yet another opportunity for you to start afresh and eject some of the baggage I’m keeping to maintain compatibility with spreadsheets I’ve produced over the years.  Feel free to rewrite these routines into just one.  Just make sure to maintain the integrity of the inputs and outputs.

This is the wrapper routine.  Keep this function name and parameters intact.  Merge the second into this if you feel energetic.

Public Function Table_Lookup_by_Name( _
            sTable As String, sResult_Col As String, _
            sSearch_Col1 As String, vKey1 As Variant, _
            Optional sSearch_Col2 As String, Optional vKey2 As Variant, _
            Optional sSearch_Col3 As String, Optional vKey3 As Variant _
            ) As Variant
   
'   Description:Wrapper for Table_Lookup
'   Parameters: sTable          Range name with keys and values
'               sResult_Col     Header of column containing result
'               sSearch_Col1    Header of first column to search
'                               NOTE: To speed things up, use the column
'                                     that is most likely to be unique
'               vKey1           Value to search for in sSearch_Column1
'               sSearch_Col2    Header of second column to search
'               vKey2           Value to search for in sSearch_Column2
'               sSearch_Col3    Header of second column to search
'               vKey3           Value to search for in sSearch_Column3
'   Example:    sAccess = Table_Lookup_By_Name("Security", "Authorized", _
'                                               "User", Cells(2,1), _
'                                               "Application", Cells(2,3))
'     Date   Init Modification
'   01/01/01 CWH  Initial Programming
    On Error GoTo ErrHandler
    Table_Lookup_by_Name = Null  'Assume not found
    Dim rngTable As Range
    Dim lResult_Col As Long
    Dim lSearch_Col1 As Long
    Dim lSearch_Col2 As Long
    Dim lSearch_Col3 As Long
   
    Set rngTable = Range(sTable)
    lResult_Col = FieldColumn(sResult_Col, sTable)
    lSearch_Col1 = FieldColumn(sSearch_Col1, sTable)
    lSearch_Col2 = FieldColumn(sSearch_Col2, sTable)
    lSearch_Col3 = FieldColumn(sSearch_Col3, sTable)
   
    If lSearch_Col1 > 0 And lResult_Col > 0 Then _
        Table_Lookup_by_Name = Table_Lookup(rngTable, lResult_Col, _
                                            lSearch_Col1, vKey1, _
                                            lSearch_Col2, vKey2, _
                                            lSearch_Col3, vKey3)
                                           
ErrHandler:
   
    If Err.Number <> 0 Then MsgBox _
        "Table_Lookup_by_Name - Error#" & Err.Number & vbCrLf & _
        Err.Description, vbCritical, "Error", Err.HelpFile, Err.HelpContext
    On Error GoTo 0
End Function
 
Public Function Table_Lookup( _
                    rngTable As Range, lResult_Col As Long, _
                    lSearch_Col1 As Long, vKey1 As Variant, _
                    Optional lSearch_Col2 As Long, Optional vKey2 As Variant, _
                    Optional lSearch_Col3 As Long, Optional vKey3 As Variant _
                    ) As Variant
'   Description:Use up to 3 search criteria to find results in a table
'   Parameters: rngTable        Range name with keys and values
'               lResult_Col     Relative column# where result should be
'               lSearch_Col1    First column# to search
'                               NOTE: To speed things up, use the column
'                                     that is most likely to be unique
'               vKey1           Key to search for in lSearch_Column1
'               lSearch_Col2    Second column# to search
'               vKey2           Key to search for in lSearch_Column2
'               lSearch_Col3    Third column# to search
'               vKey3           Key to search for in lSearch_Column3
'   Example:    sAccess = Table_Lookup(Range("Security"), 3, _
'                                          1, Cells(2,1), 2, Cells(2,3))
'     Date   Init Modification
'   01/01/01 CWH  Initial Programming
    On Error GoTo ErrHandler
    Table_Lookup = Null         'Assume not found
    Dim c As Range
    Dim LastAddress As String
   
    Dim lRow As Long
    Dim lRows As Long
   
    lRows = rngTable.Rows.Count
   
    With Range(rngTable.Cells(1, lSearch_Col1), _
               rngTable.Cells(lRows, lSearch_Col1))
        Set c = .Find(vKey1, LookIn:=xlValues, _
                      LookAt:=xlWhole, MatchCase:=False)
        If Not c Is Nothing Then
            Do
                lRow = c.Row - rngTable.Row + 1
                If lSearch_Col2 <= 0 Then
                    Table_Lookup = rngTable.Cells(lRow, lResult_Col)
                    Exit Function
                ElseIf UCase(rngTable.Cells(lRow, lSearch_Col2)) = _
                       UCase(vKey2) Then
                    If lSearch_Column3 <= 0 Then
                        Table_Lookup = rngTable.Cells(lRow, lResult_Col)
                        Exit Function
                    ElseIf UCase(rngTable.Cells(lRow, lSearch_Col3)) = _
                        UCase(vKey3) Then
                        Table_Lookup = rngTable.Cells(lRow, lResult_Col)
                        Exit Function
                    End If
                End If
                LastAddress = c.Address
                With Range(rngTable.Cells(lRow, lSearch_Col1), _
                           rngTable.Cells(lRows, lSearch_Col1))
                    Set c = .Find(vKey1, LookIn:=xlValues, _
                                  LookAt:=xlWhole, MatchCase:=False)
                End With
            Loop While Not c Is Nothing And c.Address <> LastAddress
        End If
    End With
ErrHandler:
   
    If Err.Number <> 0 Then MsgBox _
        "Table_Lookup - Error#" & Err.Number & vbCrLf & _
        Err.Description, vbCritical, "Error", Err.HelpFile, Err.HelpContext
    On Error GoTo 0
End Function
 


May 31, 2010  4:04 PM

Check Entry – Initialize Globals



Posted by: Craig Hatmaker
database, development, excel, Microsoft Excel, ms query, odbc, sql, tutorial, vba
You are here (Click to enlarge)

You are here (Click to enlarge)

As mentioned in the last post, I have chosen to use globals (variables that can be used by any routine in the entire spreadsheet/project) to keep the routines fast by eliminating repeated lookups for the same information.  An alternative approach would be to pass lengthy parameter lists.  You may want to do that in your code.  I keep wrestling with that one and am tempted to rewrite the routines without globals.  But that is for another time.

“WorkSheet_Activate” assigns values to globals specificly for updating a speadsheet to a database.  “Initialize_Globals” ” assigns values to globals that can be used for simply loading a database or updating it.

It’s all pretty straight forward.  So without futher pontification – here is the code:

These following declarations should go at the top of modTableLoadmodTableLoad contains those routines and data items required by spreadsheets that load data for databases.  This includes database reporting/analytics spreadsheets and database update spreadsheets.

'Relative Column Positions for Detail Field Definitions
Global lColTbl As Long         'Table
Global lColAls As Long         'Alias
Global lColFld As Long         'Field
Global lColKey As Long         'Key
Global lColHdg As Long         'Heading
Global lColSOrd As Long        'Sort Order (1st, 2nd, 3rd, ...)
Global lColSSeq As Long        'Sort Sequence (Asc, Dsc)
Global lColFrz As Long         'Freeze Field
Global lColSQLF As Long        'SQL Function
Global lColHid As Long         'Hide
Global lColWid As Long         'Width
Global lColFmt As Long         'Format
Global lColXLF As Long         'XL Function
Global lColInp As Long         'Input
Global lColReq As Long         'Required Flag
Global lColVTyp As Long        'Validation Type
Global lColVTbl As Long        'Validation Table
Global lColUpd As Long         'SQL Update Statement Function
Global lColNote As Long        'Notes/Error Messages

 

The following routine is a handler for the activate event in the worksheet that displays records from and permits entries to the database.  It MUST go in the worksheet (it cannot be in a module). 

Public Sub Worksheet_Activate()
    Dim lRow As Long
    Dim s As String
   
    If lColTbl = 0 Or lColACD = 0 Then 'Do once to init globals (for speed)
        Initialize_Globals sFields
               
        If sFields > "" Then
            With Worksheets("Tables").Range(sFields)
                For lRow = 2 To .Rows.Count
                    If .Cells(lRow, lColKey) <> "" And lCol1stKey = 0 Then _
                        lCol1stKey = lRow - 1
                    If .Cells(lRow, lColReq) <> "" And lCol1stReq = 0 Then _
                        lCol1stReq = lRow - 1
                    If .Cells(lRow, lColHdg) = "ACD" Then _
                        lColACD = lRow - 1
                    If .Cells(lRow, lColHdg) = "ERRORS" Then _
                        lColERRORS = lRow - 1
                Next lRow
            End With
        End If
  
    End If
End Sub

The following routine should go in modTableLoad

Function Initialize_Globals(sFieldDefinitions As String) As Boolean
'   Description:Initialize all global fields
'   Parameters: sFieldDefinitions	range name holding field definitions
'   Example:    bResult = Initialize_Globals("Fields")
'     Date   Init Modification
'   01/01/01 CWH  Initial Programming
    On Error GoTo ErrHandler            '
    Initialize_Globals = Failure        'Assume the Worst

    lColTbl = FieldColumn("Table", sFieldDefinitions)
    lColAls = FieldColumn("Alias", sFieldDefinitions)
    lColFld = FieldColumn("Field", sFieldDefinitions)
    lColKey = FieldColumn("Key", sFieldDefinitions)
    lColHdg = FieldColumn("Heading", sFieldDefinitions)
    lColSOrd = FieldColumn("S.Ord", sFieldDefinitions)
    lColSSeq = FieldColumn("S.Seq", sFieldDefinitions)
    lColFrz = FieldColumn("Freeze", sFieldDefinitions)
    lColSQLF = FieldColumn("SQL Func.", sFieldDefinitions)
    lColHid = FieldColumn("Hide", sFieldDefinitions)
    lColWid = FieldColumn("Width", sFieldDefinitions)
    lColFmt = FieldColumn("Format", sFieldDefinitions)
    lColXLF = FieldColumn("XL Func.", sFieldDefinitions)
    lColInp = FieldColumn("Input", sFieldDefinitions)
    lColReq = FieldColumn("Required", sFieldDefinitions)
    lColVTyp = FieldColumn("V.Type", sFieldDefinitions)
    lColVTbl = FieldColumn("V.Tbl", sFieldDefinitions)
    lColUpd = FieldColumn("Upd.Func.", sFieldDefinitions)
    lColNote = FieldColumn("Notes", sFieldDefinitions)
   
    Initialize_Globals = Success        'Successful finish
ErrHandler:
   
    If Err.Number <> 0 Then MsgBox _
        "Initialize_Globals - Error#" & Err.Number & vbCrLf & _
            Err.Description, vbCritical, "Error", Err.HelpFile, _
            Err.HelpContext
    On Error GoTo 0
End Function
 


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: