Beyond Excel: VBA and Database Manipulation


June 19, 2010  11:25 AM

Check Entry – Form Select – Theory and Demo

Craig Hatmaker Craig Hatmaker Profile: Craig Hatmaker

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

Craig Hatmaker Craig Hatmaker Profile: Craig Hatmaker

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

Craig Hatmaker Craig Hatmaker Profile: Craig Hatmaker

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

Craig Hatmaker Craig Hatmaker Profile: Craig Hatmaker
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

Craig Hatmaker Craig Hatmaker Profile: Craig Hatmaker
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
 


May 26, 2010  10:33 PM

Validating Data Entries

Craig Hatmaker Craig Hatmaker Profile: Craig Hatmaker
Practically no one uses Excel to update databases directly.  I think the reason is because we think of Excel as a tool that end users can do whatever they want to with and updating databases requires discipline.  Just using Excel to shotgun records into a database can be disastrous because putting bad data into a database is often far worse than putting no data in at all.  That’s not to say Excel can’t be an excellent tool for updating databases, it just means we have to approach the subject with the same discipline as we would with ‘normal’ or ‘traditional’ programming methods.
 
At the heart of that discipline is good data validation, also known as ‘edit checks’. 
 
Today’s post won’t share any code.  I want to provide an overview of the process before we start coding.  Here is a simple data flow diagram (DFD) to help the discussion.
Check Entry Overview

Check Entry Overview

As always, I use lots of little functions instead of one monolithic program.  In some cases, my purpose is to build a routine that can be used for other circumstances.  In other cases, my purpose is to isolate where changes should occur from places where, in all likelihood, they never should occur.  And in all cases, my purpose is to have small bits of code that perform specific functions that can be thoroughly tested before being placed into production.  That’s no assurance that something won’t go bump in the night (thus every routine has error handling).  Nor does it mean that experience won’t lead us to better methods and thus, changes to underlying code.
 
The first routine is the worksheet’s specific validation controller.  Though it is expected that this routine will require modifications, much of it should not need any changes (and in many cases, I have used it without any modifications).  The first function it performs is one such piece that should not need modification.  It handles some housekeeping such as making sure all global variables have been initialized (I normally don’t like global variables.  I made an exception for speed here) and clearing any previous error indications from the data to be validated.
 
Below the housekeeping piece is a loop that processes all rows, and all cells in those rows.  Within the inner loop is a place where, if you need unique data validation logic, you can put it.  Below the section set asside for your modifications is a routine that handles all the normal data validation stuff, such as checking dates, making sure numeric fields contain numbers, making sure text fields aren’t longer than they should be, converting to upper case when necessary, handling Yes or No flags, simple Excel Table lookups, and database lookups.
 
Database lookups require specific information and so the generic routine really doesn’t handle them.  It passes control back to the worksheet where a template routine awaits your modifications. 
Note: As you can see, things that need your attention, are isolated in the worksheet code.  Things that you should never have to modify are placed in modules.
 
The last function of the Check_Entry routine is to highlight any cells in error with red, provide a brief description of the problem and/or it’s resolution, and communicate back to the calling routine if any errors were found. 
 
That’s the overview.  Next post – we dive into code. 


May 24, 2010  5:11 PM

Building a Library of Routines for Updating – #7

Craig Hatmaker Craig Hatmaker Profile: Craig Hatmaker

You are here (Click to enlarge)

You are here (Click to enlarge)

As you can see from the simple DFD at right, we are almost done writing update routines.  Hopefully you are asking an important question.  Hopefully you are wondering why I haven’t covered an extremely important topic.  Hopefully you want to know how we make sure the data is correct BEFORE we update anything.

Glad you asked.
 
If you click on the DFD you will see a routine we haven’t yet covered worksheet.Check_Entry.  Its purpose is to review the user’s entries and look for any mistakes it can catch.  As a programmer – you know that this is perhaps the hardest part of coding because it can change with every application.  Since Check_Entry can be ‘worksheet’ specific, I place a unique instance of Check_Entry in any worksheet that updates data.  And given that I sometimes create workbooks that contain multiple worksheets that update data, I cannot place Check_Entry in a generic module without modifying the routine I’m going to present today.
 
This routine first calls the Check_Entry routine of the worksheet that called it.  There MUST be a routine named Check_Entry there.  Happily, it is quite possible that almost all of your Check_Entry routines will require no modification.  But it is almost certain that if you do more than a few of these spreadsheets, you are going to run into a data requirement that is so unique that the generic routines I will provide simply won’t cut it, in which case, you’re going to need to make some modifications to Check_Entry.
 
So back to today’s routine.  As I said, this routine first calls Check_Entry and if Check_Entry reports no errors, this routine then passes control down to the routines you’ve been adding to your library.  I’ve never had to modify any of these update routines and I fully expect that once you have placed them in your library, you can pretty much forget all about them.
Here is the code for Post:
 
 
Function Post(sConnect As String, sWorksheet As String, _
              sHeaderFields As String, sDetailFields As String, _
              sHeaderRange As String, sDetailRange As String, _
              sTable As String) As Boolean
'   Description:Post entries from a spreadsheet to a database table
'   Parameters: sWorksheet      Worksheet containing entries
'               sHeaderFields   Header Field descriptions range
'                               (on Tables Tab - Optional)
'               sDetailFields   Detail Field descriptions range
'               sHeaderRange    Range containing values common to all
'		              update records (Optional)
'               sDetailRange    Range containing entry rows
'               sTable          Table Name that will be updated
'			    (there can be only one)
'   Example:    bResult = Post(sConnectionString, _
'                              sDataWorkSheet, _
'                              sHeaderFieldDefinitions, _
'                              sDetailFieldDefinitions, _
'                              sHeaderData, _
'                              sDetailData, _
'                              sUpdateTable)
'     Date   Init Modification
'   01/12/06 CWH  Initial Programming
   
    On Error GoTo ErrHandler    '
    Post = Failure              'Assume Something went wrong
   
    Settings "Save"             'Save current application settings
    Settings "Disable"          'Disable events, calcs, screen updates
   
    Dim lRow As Long
    Dim bResult As Boolean
   
    bResult = Worksheets(sWorksheet).Check_Entry( _
                  Range(sDetailRange & "_Data"), _
                  sDetailRange, sDetailFields)
    If bResult <> Success Then
        MsgBox "Errors exist.  " & _
               "Correct first, the press 'Done'", vbOKOnly, "Errors"
    Else
        bResult = Update_Entries(sConnect, sWorksheet, _
                                 sHeaderRange, sDetailRange, _
                                 sHeaderFields, sDetailFields, _
                                 sTable, True)
    End If
   
    Post = bResult
   
ErrHandler:
   
    If Err.Number <> 0 Then MsgBox _
        "Post - Error#" & Err.Number & vbCrLf & Err.Description, _
        vbCritical, "Error", Err.HelpFile, Err.HelpContext
    Settings "Restore"              'Restore application settings
    On Error GoTo 0
End Function
 
 


May 18, 2010  4:11 PM

Building a Library of Routines for Updating – #6

Craig Hatmaker Craig Hatmaker Profile: Craig Hatmaker
Your are here (Click to enlarge)

Your are here (Click to enlarge)

This post’s routine, Update_Entries, cycles through all the records in an Excel range and updates any pending entries using the Update_Entry function from last post.

You may wonder why I have a single record update routine (SRUR) and a multiple record update routine (MRUR).  Why not just write a larger routine that does both?  The answer is that by having an SRUR, I can test that specific functionality very easily and I have what amounts to an entry point into the MRUR when I want to update just one record.  Since the MRUR leverages the SRUR, none of the SRUR code is duplicated in the MRUR except error handling.  However, having the routines split does cause one problem - mutliple database opens and closes.

Multliple database opens and closes slows things down dramatically.  In order to maintain speed, the SRUR accepts a connection object as well as a connection string.  If the connection object is provided, the SRUR leverages that and avoids creating its own connection to the database.  So to support that goal, we have a routine that creates a connection object that can be passed between functions – SQLConnection.

Here is the code:

Function SQLConnection(cn As ADODB.Connection, _
                       sConnect As String) As Boolean
'   Description:Create a connection to the database
'               By externalizing this, a connection can be created and reused
'   Parameters: cn - an ADODB connection object
'               sConnect - a connection string
'   Example:    bResult =  SQLConnection( _
                           cn, _
                           "Driver={Microsoft Access Driver (*.mdb)};" & _
                           "DBQ=c:\Northwind.mdb")
'     Date   Init Modification
'   01/01/01 CWH  Initial Programming
    On Error GoTo ErrHandler
    SQLConnection = Failure    'Assume Something went wrong
   
    If cn Is Nothing Then
        Set cn = New ADODB.Connection
        cn.Properties("Prompt") = adPromptComplete
        cn.Open sConnect, "", ""
    End If
   
    SQLConnection = Success
   
ErrHandler:
   
    If Err.Number <> 0 Then MsgBox _
        "SQLConnection - Error#" & Err.Number & vbCrLf & Err.Description, _
        vbCritical, "Error", Err.HelpFile, Err.HelpContext
    On Error GoTo 0
End Function
Public Function Update_Entries(sConnect As String, sWorksheet As String, _
                               sHeaderRange As String, sDetailRange As String, _
                               sHeaderFields As String, sDetailFields As String, _
                               sTable As String, bRows As Boolean) As Boolean
'   Description:Update a ALL entries (entires MUST be verfied first)
'   Parameters: sConnect       ODBC Connection String
'               sWorksheet     Worksheet containing data
'               sHeaderRange   Range holding values common to all records (Opt.)
'               sDetailRange   Range holding unique rows of data
'               sHeaderFields  Range holding common field descriptions (Opt.)
'               sDetailFields  Range holding unique row field descriptions
'               sTable         Table to be updated (there can be only one)
'               bRows          "True" if entries in rows, "False" if in columns
'   Example:    bResult = Update_Entries(sConnectionString, _
                                         sDataWorkSheet, _
                                         sHeaderData, _
                                         sDetailData, _
                                         sHeaderFieldDefinitions, _
                                         sDetailFieldDefinitions, _
                                         sUpdateTable, _
                                         True)
'     Date   Init Modification
'   01/12/06 CWH  Initial Programming
    On Error GoTo ErrHandler
    Update_Entries = Success    'Assume the Best 
    
    Settings "Save"             'Save current application settings
    Settings "Disable"          'Disable events, calcs, screen updates
   
    Dim lRow As Long            'Current Row
    Dim lRows As Long           'Number of Rows in sDetailRange
    Dim iACD As Integer         'Column holding ACD (Add,Change,Delete) instr.
    Dim iErrMsg As Integer      'Column to report Error Messages
    Dim bResult As Boolean      'Generic Result variable (Success or Failure)
    Dim cn As ADODB.Connection  'ADO Connection Object (Optional-use this when
                                'updating several records to avoid unnecessary
                                'DB opens and closes)
       
    'Establish connection to the database or fail this routine
    bResult = SQLConnection(cn, sConnect)
    Update_Entries = bResult
    If bResult = Failure Then Exit Function
  
    iACD = FieldColumn("ACD", sDetailRange)         'Must have "ACD" column
    iErrMsg = FieldColumn("ERRORS", sDetailRange)   'and an "ERRORS" column
    lRows = Range(sDetailRange).Rows.Count          'Number of data rows
    With frmProgress                                'Show Progress Bar
        .pPct = 0
        .pCaption = "Updating Entries"
        .Show False
    End With
                       
    Debug.Print "Start: "; Now()                'Start timer(for pgmr feedback)
    With Range(sDetailRange)                    'Go through all records
        lRow = 2                                'Skip column headings
        While lRow <= .Row + .Rows.Count        'Update the database
            If .Cells(lRow, iACD) > "" And _
                InStr(1, "ACD", .Cells(lRow, iACD)) > 0 Then
                bResult = Update_Entry(sConnect, sWorksheet, _
                                       sHeaderRange, sDetailRange, _
                                       sHeaderFields, sDetailFields, _
                                       sTable, lRow, iACD, iErrMsg, cn)
                If bResult = Failure Then Update_Entries = Failure
            End If
            lRow = lRow + 1
            frmProgress.pPct = lRow / lRows
        Wend
       
        lRow = 2                                'Remove deteled rows
        While lRow <= .Row + .Rows.Count
            If .Cells(lRow, iACD) = "D" And _
               .Cells(lRow, iErrMsg) = "Updated!" Then
                Rows(.Cells(lRow, 1).Row).Delete Shift:=xlUp
            Else
                lRow = lRow + 1
            End If
        Wend
    End With
    Debug.Print "End: "; Now()                  'Stop the update timer
               
    cn.Close                                    'Close connection
    frmProgress.Hide                            'Close Progress Bar
ErrHandler:
   
    If Err.Number <> 0 Then MsgBox _
        "Update_Entries - Error#" & Err.Number & vbCrLf & _
        Err.Description, vbCritical, "Error", Err.HelpFile, Err.HelpContext
    Settings "Restore"                  'Restore application settings
    On Error GoTo 0
End Function
 


May 12, 2010  7:47 PM

Building a Library of Routines for Updating – #5

Craig Hatmaker Craig Hatmaker Profile: Craig Hatmaker
You are here (click to enlarge)

You are here (click to enlarge)

We’re still building the routines necessary to update a database from entries in Excel.  The thumbnail at right is a simple data flow diagram that shows how these routines fit together.  Click on it to enlarge it.  We’ve been working from the bottom up and now we are on what this diagram has as step 8 – Update_Entry.  

Update_Entry updates a single record.  Its parent handles cycling through all Excel entries, passing them one by one to Update_Entry.  We will see that routine in the next post.  Here is the code for Update_Entry.

Public Function Update_Entry(sConnect As String, sWorksheet As String, _
                             sData As String, sFields As String, _
                             sPath As String, lRow As Long, _
                             iACD As Integer, iNotes As Integer, _
                             Optional cn As ADODB.Connection) As Boolean
'   Description:Update a single entry.  Entries MUST be verfied correct
'               before calling this routine.
'   Parameters: sConnect    ODBC Connection String. Leave blank if the
'                           Connection Object (see cn) is created outside
'                           this routine.
'               sWorksheet  Worksheet's name that contains the data
'               sData       Range's name containing the unique rows of data
'               sFields     Range's name containing field descriptions
'               sPath       Table with path (if needed) to update
'               lRow        XL row containing data to be updated/inserted
'               iACD        XL column for ACD entries (Add,Change,Delete)
'               iNotes      XL column to post error messages
'               cn          Persistent connection object.  Use for speedy
'                           updating of multiple records.
'   Example:    bResult = Update_Entry(sConnectionString, _
'                                      "Data", _
'                                      "Data", _
'                                      "Fields", _
'                                      sUpdateTable, _
'                                      lCurrentRow, _
'                                      FieldColumn("ACD","Data"),
'                                      FieldColumn("ERRORS","Data"),
'                                      cn)
'     Date   Init Modification
'   01/12/06 CWH  Initial Programming
    On Error GoTo ErrHandler
    Update_Entry = Failure      'Assume the worse
      
    Settings "Save"             'Save current application settings
    Settings "Disable"          'Disable events, calcs, screen updates
       
    Dim lCol As Long            'Current Column
    Dim sSQL As String          'SQL string
    Dim sCRTB As String         'Carriage Return and two Tabs
    Dim bOpen As Boolean        'Was Connection open when routine called?
           
    sCRTB = vbCr & vbTab & vbTab
   
    'If the Connection wasn't created by the calling routine, make one
    bOpen = Not cn Is Nothing
    If Not bOpen Then
        If SQLConnection(cn, sConnect) = Failure Then Exit Function
    End If
   
    With Range(sData)
              
        'Check Entries. Notes should be blank and ACD should not be "X"
        If .Cells(lRow, iNotes) > "" Then Exit Function
       
        'Update Entries
        sSQL = ""
        Dim sTable As String    'Table without Path
        Dim sSlash As String    'Path seperator used
        sSlash = IIf(InStr(1, "/", sPath) > 0, "\", "/")
        sTable = Right(sPath, Len(sPath) - _
                    Chars_Last_Position(sSlash, sPath))
        Select Case UCase(.Cells(lRow, iACD))
            Case Is = "A"
                sSQL = vbCr & _
                    "Insert Into " & sPath & " " & sCRTB & "(" & _
                        Build_SQL_Insert_Fields(sFields, sTable) & _
                            ") " & vbCr & _
                    "Values (" & _
                        Build_SQL_Insert_Values(sFields, sTable, _
                            sData, lRow - 1, True) & ") "
            Case Is = "C"
                sSQL = vbCr & _
                    "Update  " & sPath & " " & vbCr & _
                    "Set     " & _
                        Build_SQL_Update_Values(sFields, sTable, _
                            sData, lRow - 1, True) & " " & vbCr & _
                    "Where   " & _
                        Build_SQL_UpdDlt_Where_Clause(sFields, sTable, _
                            sData, lRow - 1, True)
            Case Is = "D"
               sSQL = vbCr & _
                    "Delete  From " & sPath & " " & vbCr & _
                    "Where   " & _
                        Build_SQL_UpdDlt_Where_Clause(sFields, sTable, _
                            sData, lRow - 1, True)
        End Select
   
        If sSQL > "" Then
            Debug.Print sSQL
            cn.Execute sSQL
            If cn.Errors.Count = 0 Then
                .Cells(lRow, iNotes) = "Updated!"
                Update_Entry = Success          'Successful finish
                If (.Cells(lRow, iACD)) <> "D" Then _
                    .Cells(lRow, iACD) = "X"
            Else
                .Cells(lRow, iNotes) = "Errors prevented updating. " & _
                    cn.Errors(0).Description
            End If
        End If
       
    End With
   
ErrHandler:
   
    If Err.Number <> 0 Then MsgBox _
        "Update_Entry - Error#" & Err.Number & vbCrLf & Err.Description, _
        vbCritical, "Error", Err.HelpFile, Err.HelpContext
    On Error Resume Next
    Range(sData).Cells(lRow, iNotes) = "Errors prevented updating. " & _
        cn.Errors(0).Description
    If Not bOpen Then cn.Close      'Close connection if opened here
    Settings "Restore"              'Restore application settings
    On Error GoTo 0
   
End Function


May 6, 2010  8:34 PM

Building a Library of Routines for Updating – #4

Craig Hatmaker Craig Hatmaker Profile: Craig Hatmaker

We are just about finished with adding support routines for updating, inserting, and deleting records in a database.  As a reminder, these routines should never need modification. 

The first routine should go in modSQL.  It is used to create a connection object that can be reused.  This can greatly speed processing be eliminating constently opening and closing database connections for each insert, update, or delete.

The second routine finds the last position of a character in a string.  This is used to strip table/file names from path strings.  It can have other applications and thus, should be place in modGeneral.

Function SQLConnection(cn As ADODB.Connection, _
                       sConnect As String) As Boolean
'   Description:Create a connection to the database
'               By externalizing this, a connection can be reused
'   Parameters: cn          an ADODB connection object
'               sConnect    Connection string
'   Example:    bResult = _
                    SQLConnection(cn, _
'                       "Driver={Microsoft Access Driver (*.mdb)};" & _
'                       "DBQ=c:\Northwind.mdb")
'     Date   Init Modification
'   01/01/01 CWH  Initial Programming
    On Error GoTo ErrHandler
    SQLConnection = Failure    'Assume Something went wrong
   
    If cn Is Nothing Then
        Set cn = New ADODB.Connection
        cn.Properties("Prompt") = adPromptComplete
        cn.Open sConnect, "", ""
    End If
   
    SQLConnection = Success
   
ErrHandler:
   
    If Err.Number <> 0 Then MsgBox _
        "SQLConnection - Error#" & Err.Number & vbCrLf & Err.Description, _
        vbCritical, "Error", Err.HelpFile, Err.HelpContext
    On Error GoTo 0
End Function
 
Function Chars_Last_Position(sCharacter As String, _
                             sString As String) As Integer
'   Description:Returns position of last occurance of a character
'               in a string
'   Parameters: sCharacter  Character to find
'               sString     String to search for character
'   Example:    sTable = Right(sPath, len(sPath) - _
'                           Chars_Last_Position("/", sPath))
'     Date   Init Modification
'   01/01/01 CWH  Initial Programming
    On Error GoTo ErrHandler
    Dim i As Integer
   
    Chars_Last_Position = 0         'Assume not found
   
    i = 0
    Do
        i = InStr(i + 1, sString, sCharacter, vbTextCompare)
        If i > 0 Then Chars_Last_Position = i
    Loop Until i = 0
   
ErrHandler:
   
    If Err.Number <> 0 Then MsgBox _
        "Settings - 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: