Beyond Excel: VBA and Database Manipulation

Jun 2 2010   9:27PM GMT

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
 

 Comment on this Post

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

REGISTER or login:

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

Forgot Password

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

Your password has been sent to: