[ Read on Experts-Exchange ]This is the typical "I need the last (first) of something" question, with one thousand answers. It's frustrating because a clever mixture of aggregate and lookup functions can do the job, but the expression looks ugly and inefficient.
Question, by Asker: I need to find the last appointment of a patient.
Expert: Sure: DMax("AppDate", "Appointments", "PatientID=101") -- Enjoy!
Asker: Thanks, but that gives me the date, I need the appointment ID.
Expert: Oh... wait... I think I got it: You need to get the date like before, store it in a date variable (unless there is no previous date, then it would have to be a variant, and you can test for Null). Say the variable is datPrev, then lookup the ID, with something like this : DLookup("AppointmentID", "Appointments", "PatientID=101 And AppointmentDate = #" & datLast & "#"). Notice the #, this is needed for dates. -- Good Luck!
Expert: Typo. Meant datPrev.
Asker: Huh? This seems awfully complicated. What do I type in the text box?
Member: Just use DLast("AppointmentID", "Appointments", "PatientID=101")
Asker: Thanks, Member! Exactly what I was looking for!
Expert: With all due respect, Member, have you read the help page on DLast? E.g. the words "return[s] a random record " and "[use it] when you simply need any value from that field"?
Member: Try it!
You can imagine the rest. DLast() fails after waisting everybodys time, Expert2 comes in to suggest a user defined function, Expert3 thinks that this should be done in a query, Expert1 tries to nest DMax() into DLookup() in a single expression while correcting Expert2's function...
Asker: It should be simple: I need the last appointment of a patient. Why isn't there a function for that?
[ Another day on Experts-Exchange ]Again, is there no function to do this in Access?
Question, by Asker: I have a table with players, and I want the names of the players from Texas, with 'TX' in the field State.
Expert: SELECT FullName FROM TableWithPlayers WHERE State='TX'
Asker: Thanks. Is this a query?
Expert: Yes, just paste it into a new query in SQL view, after adjusting table and field names.
Asker: I need this in a text box.
Expert: Perhaps you can use a list box. Paste the SQL as "record source".
Asker: I just want a list, like: Smith, Adams, Kruger.
Expert: Oh... You will need to build the list using a function. Is this for a report? You could use the Format event and...
'-------------------------------------------------------------------------------
' "Missing lookup functions" -- Access version
' Written for Experts Exchange: www.experts-exchange.com
' Article and help page: www.experts-exchange.com/A_2011.html
' Copyright Markus G Fischer, Geneva 2009
'-------------------------------------------------------------------------------
'
' This module implements two original lookup functions, DFind() and DList()
'
' Both are similar to DLookup, but provide a solution when several records
' match the criteria: selecting the first using a specific sort order, or
' showing them all in a list.
'
' Optional reference: Microsoft DAO ?.? Object Library
' allows replacing "Options:=4" with "Options:=dbReadOnly"
'
Option Explicit
' Settings for the functions
Const SHOW_ERROR As Boolean = True ' Return Error or Null on Error?
Const MAX_LIST As Integer = 100 ' Limits the items for DList()
' DFind(Expr, Domain, [Criteria], [Order])
'
' Similar to DLookup, with an additional argument. If several records match
' the Criteria, the Order argument is used to pick one.
'
' Example: Name of the youngest employee
' ? DFind("FirstName", "Employees", Order:="BirthDate DESC")
'
Function DFind(Expr As String, Domain As String, _
Optional Criteria = Null, Optional Order = Null)
Dim strSQL As String
Dim intN as Integer
On Error GoTo Failure
strSQL _
= " SELECT TOP 1 " & Expr _
& " FROM " & Domain _
& " WHERE " + Criteria _
& " ORDER BY " + Order
DFind = Null
With DBEngine(0)(0).CreateQueryDef("", strSQL)
For intN = 0 To .Parameters.Count - 1
.Parameters(intN) = Eval(.Parameters(intN).Name)
Next intN
With .OpenRecordset(Options:=4)
If .RecordCount Then DFind = .Fields(0)
End With
End With
Exit Function
Failure:
If SHOW_ERROR Then DFind = CVErr(Err.Number)
Err.Clear
End Function
' DList(Expr, Domain, [Criteria], [Order], [Sep])
'
' Similar to DFind, but returning Expr for each record found as a list, using
' the argument Sep as separator.
'
' Example: alphabetised list of Products for a Supplier
' ? DList("ProductName", "Products", "SupplierID=1", "ProductName", vbCrLf)
'
Function DList(Expr As String, Domain As String, _
Optional Criteria = Null, Optional Order = Null, _
Optional Sep As String = ", ")
Dim strSQL As String
Dim intN As Integer
On Error GoTo Failure
strSQL _
= " SELECT " & Expr _
& " FROM " & Domain _
& " WHERE " + Criteria _
& " ORDER BY " + Order
DList = Null
With DBEngine(0)(0).CreateQueryDef("", strSQL)
For intN = 0 To .Parameters.Count - 1
.Parameters(intN) = Eval(.Parameters(intN).Name)
Next intN
With .OpenRecordset(Options:=4)
intN = 0
Do Until .EOF
If intN > MAX_LIST Then
DList = DList + Sep & "..."
Exit Do
End If
DList = DList + Sep & .Fields(0)
intN = intN + 1
.MoveNext
Loop
End With
End With
Exit Function
Failure:
If SHOW_ERROR Then DList = CVErr(Err.Number)
Err.Clear
End Function
(open in new tab)
'-------------------------------------------------------------------------------
' "Missing lookup functions" -- VB stand-alone version
' Written for Experts Exchange: www.experts-exchange.com
' Article and help page: www.experts-exchange.com/A_2011.html
' Copyright Markus G Fischer, Geneva 2009
'-------------------------------------------------------------------------------
'
' This module implements two original lookup functions, as well as the built-in
' Access domain functions.
'
' These functions are implemented by the Access Application object, and are as
' such not available in stand-alone VB or another flavour of VBA.
'
' These functions operate on the CurrentDb, so a property with this name is
' provided for readability. CurrentDb will return a DAO database object for
' the application's default Jet database (see the constant below).
'
' References: Microsoft DAO ?.? Object Library
'
Option Explicit
' Application's Jet Database:
Const CurrentDb_PATH As String = "C:\...\NorthWind.mdb"
' Settings for the functions
Const SHOW_ERROR As Boolean = True ' Return Error or Null on Error?
Const MAX_LIST As Integer = 100 ' Limits the items for DList()
Private dbJet As DAO.Database ' static database object
' CurrentDb -- Returns the current database
'
' Replace with your own database object if needed
'
Public Property Get CurrentDb() As DAO.Database
If dbJet Is Nothing Then Set dbJet = DAO.OpenDatabase(CurrentDb_PATH)
Set CurrentDb = dbJet
End Property
' Nz(Value, [ValueIfNull]) -- compatible with Access' Nz() function
'
' The way Empty can be returned is compatible with the Access implementation
'
Function Nz(Value, Optional ValueIfNull = Empty)
If Not IsNull(Value) Then Nz = Value Else Nz = ValueIfNull
End Function
' DFind(Expr, Domain, [Criteria], [Order])
'
' Similar to DLookup, with an additional argument. If several records match
' the Criteria, the Order argument is used to pick one.
'
' Example: Name of the youngest employee
' ? DFind("FirstName", "Employees", Order:="BirthDate DESC")
'
Function DFind(Expr As String, Domain As String, _
Optional Criteria = Null, Optional Order = Null)
Dim strSQL As String
On Error GoTo Failure
strSQL _
= " SELECT TOP 1 " & Expr _
& " FROM " & Domain _
& " WHERE " + Criteria _
& " ORDER BY " + Order
DFind = Null
With CurrentDb.OpenRecordset(strSQL, Options:=4)
If .RecordCount Then DFind = .Fields(0)
End With
Exit Function
Failure:
If SHOW_ERROR Then DFind = CVErr(Err.Number)
Err.Clear
End Function
' DList(Expr, Domain, [Criteria], [Order], [Sep])
'
' Similar to DFind, but returning Expr for each record found as a list, using
' the argument Sep as separator.
'
' Example: alphabetised list of Products for a Supplier
' ? DList("ProductName", "Products", "SupplierID=1", "ProductName", vbCrLf)
'
Function DList(Expr As String, Domain As String, _
Optional Criteria = Null, Optional Order = Null, _
Optional Sep As String = ", ")
Dim strSQL As String
Dim intN As Integer
On Error GoTo Failure
strSQL _
= " SELECT " & Expr _
& " FROM " & Domain _
& " WHERE " + Criteria _
& " ORDER BY " + Order
DList = Null
With CurrentDb.OpenRecordset(strSQL, Options:=4)
Do Until .EOF
If intN > MAX_LIST Then
DList = DList + Sep & "..."
Exit Do
End If
DList = DList + Sep & .Fields(0)
intN = intN + 1
.MoveNext
Loop
End With
Exit Function
Failure:
If SHOW_ERROR Then DList = CVErr(Err.Number)
Err.Clear
End Function
' Implementation of the domain lookup functions found in Access
Function DLookup(Expr As String, Domain As String, Optional Criteria = Null)
DLookup = DFind(Expr, Domain, Criteria)
End Function
Function DCount(Expr As String, Domain As String, Optional Criteria = Null)
DCount = DFind("Count(" & Expr & ")", Domain, Criteria)
End Function
Function DSum(Expr As String, Domain As String, Optional Criteria = Null)
DSum = DFind("Sum(" & Expr & ")", Domain, Criteria)
End Function
Function DAvg(Expr As String, Domain As String, Optional Criteria = Null)
DAvg = DFind("Avg(" & Expr & ")", Domain, Criteria)
End Function
Function DMin(Expr As String, Domain As String, Optional Criteria = Null)
DMin = DFind("Min(" & Expr & ")", Domain, Criteria)
End Function
Function DMax(Expr As String, Domain As String, Optional Criteria = Null)
DMax = DFind("Max(" & Expr & ")", Domain, Criteria)
End Function
Function DStDev(Expr As String, Domain As String, Optional Criteria = Null)
DStDev = DFind("StDev(" & Expr & ")", Domain, Criteria)
End Function
Function DStDevP(Expr As String, Domain As String, Optional Criteria = Null)
DStDevP = DFind("StDevP(" & Expr & ")", Domain, Criteria)
End Function
Function DVar(Expr As String, Domain As String, Optional Criteria = Null)
DVar = DFind("Var(" & Expr & ")", Domain, Criteria)
End Function
Function DVarP(Expr As String, Domain As String, Optional Criteria = Null)
DVarP = DFind("VarP(" & Expr & ")", Domain, Criteria)
End Function
' Two versions are available for DFirst() and DLast():
' (change True to False, or delete the unwanted version)
'
#If True Then ' Access compatibility
' Similar to built-in implementation (and just as useless):
Function DFirst(Expr As String, Domain As String, Optional Criteria = Null)
DFirst = DFind("First(" & Expr & ")", Domain, Criteria)
End Function
Function DLast(Expr As String, Domain As String, Optional Criteria = Null)
DLast = DFind("Last(" & Expr & ")", Domain, Criteria)
End Function
#Else ' NOT compatible with Access
' Somewhat smarter: auto-sorts by the Expr argument
Function DFirst(Expr As String, Domain As String, Optional Criteria = Null)
DFirst = DFind(Expr, Domain, Criteria, Expr & " ASC")
End Function
Function DLast(Expr As String, Domain As String, Optional Criteria = Null)
DLast = DFind(Expr, Domain, Criteria, Expr & " DESC")
End Function
#End If
(open in new tab)
¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
DFind(Expr, Domain, [Criteria], [Order])
Returns a single value based on the arguments:
Expr is an expression. It is often simply a field name from domain, but can include calculations, string operations, and formatting. All built-in and user-defined functions are available, as well as Access objects such as controls on a form. If needed, enclose your field names with square brackets.
Domain describes the records being searched. It is normally the name of a table or of a saved query. If needed (if it contains spaces or other invalid characters), the name must be enclosed in square brackets. This is the major difference with DLookup, which will add them for you. Unlike DLookup's domain argument, you can also specify multiple tables as source, as demonstrated in the "Advanced Tricks" examples.
Criteria is an optional string containing a logical expression using fields from domain. Only the records that satisfy the condition can be returned. Building a valid criteria is sometimes complicated, see the "Criteria Examples" below. Fundamentally, a criteria is a query's WHERE clause without the word "where".
Order is the additional optional argument, specifying how the found records should be sorted. It is a list of fields or expressions, separated by commas, each followed optionally by the keywords 'ASC', for ascending -- the default, or 'DESC', for descending. DFind returns only one value, the one at the top of the ordered list. When order is left blank and several records match the criteria, any available record is used.
When no records are found, the function returns Null. If an error occurs, both syntax errors and run-time errors, the function returns a Variant with subtype Error, containing only the error number. In Access, this number can be translated using AccessError(). This method of error handling is best suited for functions called from queries or forms, since only the message '#Error' is displayed, without interrupting the code. If you prefer that the functions return Null on error, set the constant SHOW_ERROR to False at the top of the module.
____________________
¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
DList(Expr, Domain, [Criteria], [Order], [Sep])
Returns a list instead of a single value, using arguments identical to DFind(), with the following differences:
Expr is an expression, as before. However, it can contain the keyword 'DISTINCT' before the expression; this will remove duplicates from the list. As a side effect, it also sorts the list in ascending order (alphabetical or numerical, depending on the expression).
Domain and criteria are unchanged.
Order does not work in conjunction with 'DISTINCT', except to reverse the sort order. For example, if the expr argument is "DISTINCT Country", then the order can only contain "Country DESC".
Sep is the list separator. It defaults to a comma and a space. Typical choices are "; ", "/", and vbCrLf or Chr(13)+Chr(10) to obtain a list with each item on a new line.
The number if items returned is limited to 100; this can be adjusted in the module by changing the constant MAX_LIST. The constant SHOW_ERROR has the same meaning and effect as for DFind().
____________________
Function DConcat(Expr As String, Domain As String, _
Optional Criteria = Null, Optional Order = Null, _
Optional Delim As String = ", ")
'
' Similar to DLookup, but returning a concatenated list
'
On Error Resume Next
DConcat = Null
With New ADODB.Recordset
.Open "Select " & Expr & " From " & Domain _
& " Where " + Criteria & " Order By " + Order _
, CurrentProject.Connection, adOpenDynamic, adLockReadOnly
If Not .EOF Then
DConcat = .GetString(RowDelimeter:=Delim)
DConcat = Left(DConcat, Len(DConcat) - Len(Delim))
End If
End With
End Function
[ Tomorrow on Experts-Exchange ]
...
Expert: There is a simple solution: DFind("AppID", "Appointments", "PatientID=101", "AppDate Desc")
...
Expert: To create the list, you can use DList("FullName", "TableWithPlayers", "Sate='TX'")
Have a question about something in this article? You can receive help directly from the article author. Sign up for a free trial to get started.
Comments (1)
Author
Commented:During the editorial process, I already wanted to link to this article in two or three question threads, and ended up just posting the relevant function. One of them actually made me revisit the code, and add the evaluation of Access objects used in the arguments, making the code more useful and less error-prone.
I hope the article will prove to be useful.
Markus -- (°v°)