By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
424,694 Members | 1,795 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 424,694 IT Pros & Developers. It's quick & easy.

VBA Solution for Simulating Excel VLookup in Access

P: 13
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.

Expand|Select|Wrap|Line Numbers
  1.  
  2.  
  3. Public Function AccessVLookup(strTable As String, strLookupField As String, _
  4.     varLookupValue As Variant, strReturnField As String, _
  5.     Optional strCriteriaField As String, Optional varCriteriaValue As Variant) As Variant
  6.  
  7. 'Aaron Ringer 26 Feb 08
  8.  
  9. 'Simulates the Excel VLookup function in Access, complete with Range Lookup argument.
  10. 'I've used it to look up currency exchange rates, to get the XRate active at the given date.
  11. 'It means that there doesn't have to be an entry on the given date, it'll find the next lowest value.
  12. 'Can be used to look up anything, as long as the lookup field contains numeric data.
  13. 'Returns zero if nothing found.
  14.  
  15. 'strTable = Name of lookup table.
  16. 'strLookupField = Name of field to search.
  17. 'varLookupValue = Value to look for in lookup field.
  18. 'strReturnField = Field to return value from.
  19.  
  20. 'Example:
  21. 'Gets the exchange rate for the given currency active as of today.
  22. 'dblExchangeRate = AccessVLookup("tblCurrencyExchangeRate", "EffectiveDate", Date, "ExchangeRate", "CurrencyID", lngCurrencyID)
  23.  
  24.   Dim strSQL As String
  25.   Dim qdf As DAO.QueryDef
  26.   Dim rst As DAO.Recordset
  27.  
  28.   strSQL = "SELECT "
  29.   strSQL = strSQL & "T1." & strReturnField
  30.   strSQL = strSQL & " FROM " & strTable & " AS T1 "
  31.   strSQL = strSQL & "WHERE T1." & strLookupField & "="
  32.   strSQL = strSQL & "(SELECT Max(T2." & strLookupField & ") "
  33.   strSQL = strSQL & "FROM " & strTable & " AS T2 "
  34.   strSQL = strSQL & "WHERE T2." & strLookupField & " <= "
  35.   strSQL = strSQL & "[LookupValue]"
  36.  
  37.   If Len(strCriteriaField) > 0 Then
  38.     strSQL = strSQL & " AND [" & strCriteriaField & "]"
  39.     strSQL = strSQL & " = " & varCriteriaValue
  40.   End If
  41.  
  42.   strSQL = strSQL & ")"
  43.  
  44.   Set qdf = CurrentDb.CreateQueryDef("", strSQL)
  45.  
  46.   qdf.Parameters("LookupValue") = varLookupValue
  47.   Set rst = qdf.OpenRecordset
  48.   If rst.RecordCount > 0 Then AccessVLookup = rst.Fields(strReturnField)
  49.  
  50.   rst.Close
  51.   qdf.Close
  52.   Set rst = Nothing
  53.   Set qdf = Nothing
  54.  
  55. End Function
  56.  
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!
Mar 18 '08 #1
Share this Question
Share on Google+
1 Reply


P: 13
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:

Expand|Select|Wrap|Line Numbers
  1. Public Function AccessVLookup(strTable As String, strLookupField As String, _
  2.     varLookupValue As Variant, strReturnField As String, _
  3.     Optional strCriteriaField As String, Optional varCriteriaValue As Variant) As Variant
  4.  
  5. 'Aaron Ringer 28 Jan 09
  6.  
  7. 'Simulates the Excel VLookup function in Access, complete with Range Lookup argument.
  8. 'I've used it to look up currency exchange rates, to get the XRate active at the given date.
  9. 'It means that there doesn't have to be an entry on the given date, it'll find the next lowest value.
  10. 'Can be used to look up anything, as long as the lookup field contains numeric data.
  11. 'Returns zero if nothing found.
  12.  
  13. 'strTable = Name of lookup table.
  14. 'strLookupField = Name of field to search.
  15. 'varLookupValue = Value to look for in lookup field.
  16. 'strReturnField = Field to return value from.
  17.  
  18. 'Example:
  19. 'Gets the exchange rate for the given currency active as of today.
  20. 'dblExchangeRate = AccessVLookup("tblCurrencyExchangeRate", "EffectiveDate", Date, "ExchangeRate", "CurrencyID", lngCurrencyID)
  21.  
  22.   Dim strSQL As String
  23.   Dim qdf As DAO.QueryDef
  24.   Dim rst As DAO.Recordset
  25.  
  26.   strSQL = "SELECT "
  27.   strSQL = strSQL & "T1." & strReturnField
  28.   strSQL = strSQL & " FROM " & strTable & " AS T1 "
  29.   strSQL = strSQL & "WHERE T1." & strLookupField & "="
  30.   strSQL = strSQL & "(SELECT Max(T2." & strLookupField & ") "
  31.   strSQL = strSQL & "FROM " & strTable & " AS T2 "
  32.   strSQL = strSQL & "WHERE T2." & strLookupField & " <= "
  33.   strSQL = strSQL & "[LookupValue]"
  34.  
  35.   If Len(strCriteriaField) > 0 Then
  36.     strSQL = strSQL & " AND [" & strCriteriaField & "]"
  37.     strSQL = strSQL & " = " & varCriteriaValue
  38.   End If
  39.  
  40. 'Need this extra criteria, or may return value from other record with same value in strLookupField.
  41.   strSQL = strSQL & " AND T1." & strCriteriaField
  42.   strSQL = strSQL & " = " & varCriteriaValue
  43.  
  44.   strSQL = strSQL & ")"
  45.  
  46.   Set qdf = CurrentDb.CreateQueryDef("", strSQL)
  47.  
  48.   qdf.Parameters("LookupValue") = varLookupValue
  49.   Set rst = qdf.OpenRecordset
  50.   If rst.RecordCount > 0 Then AccessVLookup = rst.Fields(strReturnField)
  51.  
  52.   rst.Close
  53.   qdf.Close
  54.   Set rst = Nothing
  55.   Set qdf = Nothing
  56.  
  57. End Function
  58.  
Jan 27 '09 #2

Post your reply

Sign in to post your reply or Sign up for a free account.