VBA Solution for Simulating Excel VLookup in Access

[scubasteve]

Looking up values from an Access table is simple. Simulating the 'Range Lookup' functionality from Excel's VLookup formula is a bit trickier.

For those that aren't familiar with this, it allows you to look up the next smallest value to what you provided, and return any corresponding field from the table. Very useful for looking up things like currency exchange rates, tax rates, etc., where there might not be an entry for every day/income level/etc.

This code is based on a hard-coded solution I found at:

http://www.access-programmers.co. uk/forums/showthread.php? t=69080

Thanks to ByteMyzer for providing the concept, I've just made it into a flexible VBA function.

Public Function AccessVLookup(strTable As String, strLookupField As String, _
    varLookupValue As Variant, strReturnField As String, _
    Optional strCriteriaField As String, Optional varCriteriaValue As Variant) As Variant

'Aaron Ringer 26 Feb 08

'Simulates the Excel VLookup function in Access, complete with Range Lookup argument.
'I've used it to look up currency exchange rates, to get the XRate active at the given date.
'It means that there doesn't have to be an entry on the given date, it'll find the next lowest value.
'Can be used to look up anything, as long as the lookup field contains numeric data.
'Returns zero if nothing found.

'strTable = Name of lookup table.
'strLookupField = Name of field to search.
'varLookupValue = Value to look for in lookup field.
'strReturnField = Field to return value from.

'Example:
'Gets the exchange rate for the given currency active as of today.
'dblExchangeRate = AccessVLookup("tblCurrencyExchangeRate", "EffectiveDate", Date, "ExchangeRate", "CurrencyID", lngCurrencyID)

  Dim strSQL As String
  Dim qdf As DAO.QueryDef
  Dim rst As DAO.Recordset
  
  strSQL = "SELECT "
  strSQL = strSQL & "T1." & strReturnField
  strSQL = strSQL & " FROM " & strTable & " AS T1 "
  strSQL = strSQL & "WHERE T1." & strLookupField & "="
  strSQL = strSQL & "(SELECT Max(T2." & strLookupField & ") "
  strSQL = strSQL & "FROM " & strTable & " AS T2 "
  strSQL = strSQL & "WHERE T2." & strLookupField & " <= "
  strSQL = strSQL & "[LookupValue]"
  
  If Len(strCriteriaField) > 0 Then
    strSQL = strSQL & " AND [" & strCriteriaField & "]"
    strSQL = strSQL & " = " & varCriteriaValue
  End If
  
  strSQL = strSQL & ")"
  
  Set qdf = CurrentDb.CreateQueryDef("", strSQL)
  
  qdf.Parameters("LookupValue") = varLookupValue
  Set rst = qdf.OpenRecordset
  If rst.RecordCount > 0 Then AccessVLookup = rst.Fields(strReturnField)
  
  rst.Close
  qdf.Close
  Set rst = Nothing
  Set qdf = Nothing

End Function

I've spent a bit of time on it, but haven't thoroughly optimised it - if anyone can suggest any improvements, please let us all know.

Enjoy!

[scubasteve]

I've found a flaw in the function which meant that, if there are several records with the same LookupValue, it might not return the right one.

Fixed function:

Public Function AccessVLookup(strTable As String, strLookupField As String, _
    varLookupValue As Variant, strReturnField As String, _
    Optional strCriteriaField As String, Optional varCriteriaValue As Variant) As Variant

'Aaron Ringer 28 Jan 09

'Simulates the Excel VLookup function in Access, complete with Range Lookup argument.
'I've used it to look up currency exchange rates, to get the XRate active at the given date.
'It means that there doesn't have to be an entry on the given date, it'll find the next lowest value.
'Can be used to look up anything, as long as the lookup field contains numeric data.
'Returns zero if nothing found.

'strTable = Name of lookup table.
'strLookupField = Name of field to search.
'varLookupValue = Value to look for in lookup field.
'strReturnField = Field to return value from.

'Example:
'Gets the exchange rate for the given currency active as of today.
'dblExchangeRate = AccessVLookup("tblCurrencyExchangeRate", "EffectiveDate", Date, "ExchangeRate", "CurrencyID", lngCurrencyID)

  Dim strSQL As String
  Dim qdf As DAO.QueryDef
  Dim rst As DAO.Recordset
  
  strSQL = "SELECT "
  strSQL = strSQL & "T1." & strReturnField
  strSQL = strSQL & " FROM " & strTable & " AS T1 "
  strSQL = strSQL & "WHERE T1." & strLookupField & "="
  strSQL = strSQL & "(SELECT Max(T2." & strLookupField & ") "
  strSQL = strSQL & "FROM " & strTable & " AS T2 "
  strSQL = strSQL & "WHERE T2." & strLookupField & " <= "
  strSQL = strSQL & "[LookupValue]"
  
  If Len(strCriteriaField) > 0 Then
    strSQL = strSQL & " AND [" & strCriteriaField & "]"
    strSQL = strSQL & " = " & varCriteriaValue
  End If
  
'Need this extra criteria, or may return value from other record with same value in strLookupField.
  strSQL = strSQL & " AND T1." & strCriteriaField
  strSQL = strSQL & " = " & varCriteriaValue
  
  strSQL = strSQL & ")"
  
  Set qdf = CurrentDb.CreateQueryDef("", strSQL)
  
  qdf.Parameters("LookupValue") = varLookupValue
  Set rst = qdf.OpenRecordset
  If rst.RecordCount > 0 Then AccessVLookup = rst.Fields(strReturnField)
  
  rst.Close
  qdf.Close
  Set rst = Nothing
  Set qdf = Nothing

End Function