Beyond Excel: VBA and Database Manipulation

Jun 12 2010   11:12PM GMT

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

2  Comments 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
  • MarcoMagal
    Can 't replicate I have always #Name as result. I use Excel 2010.
    Any Reference I should ADD?
    Thanks
    0 pointsBadges:
    report
  • Craig Hatmaker
    Hi Marco, Thanks for reading. References are not needed. #Name implies a few possibilities:
  • The function is marked PRIVATE instead of PUBLIC
  • The function is in a worksheet module instead of a regular module
  • The module has the Option Private directive
  • The function's name is misspelled in the module
  • The function's name is misspelled in the XL Cell
  • Since this is a very old post let me offer the newest version. It is contained in module modGeneral in project PapaGantt.xlsm. PapaGantt is a free, simplified project management tool. All source code is provided. User and Technical instructions are in the link below. The PDF contains links to download PapaGantt.xlsm. https://dl.dropboxusercontent.com/u/13737137/Projects/Gantt/PapaGantt.pdf
    1,775 pointsBadges:
    report

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: