How to make DLookup faster in Access VBA?

Please bear with me. I am still new to Access VBA.

TBL_Orders is an external source = SharePoint list linked where entries are now 5,000+ and will keep having more entries.

Ordered_By is a field of the names of the persons who made orders.

txtTicket is a textfield in the form which accepts numbers that when matched in its ID of TBL_Orders, txtOrderedBy displays the correct name of the person.

I have here a DLookup function that works very well and this is the only DLookup coded in the whole form.

Private Sub txtTicket_AfterUpdate()
    txtOrderedBy.Value = Nz(DLookup("[Ordered_By]", "[TBL_Orders]", "[ID] = " & [txtTicket]))
End Sub

However, the displaying of the name of the person in txtOrderedBy.Value per afterupdate of txtTicket.value has a delay of 7-8 seconds.

I tried to duplicate the external table to make it like a local table and check if the reason of the delay is the source being external but I get an error that says, 'Couldn't find the ".'

So I was not able to copy and test it.

But what could be causing the delay and how to make DLookup display a value instantly after update of txtTicket textfield?

Your help is greatly appreciated.

Solution

I'm not sure if it will help in your case but I use in my databases a DLookup replacement (incl. the other D-functions) based on recordsets. This is much faster than the built in functions. Names are similar and parameters are the same, just replace D by T in the name so that DLookup becomes TLookup.

Here is the code to be copied in a new module:

Option Compare Database   'Use database order for string comparisons
Option Explicit

' Replacement Functions for DLookup, DCount & DSum , DMax & DMin
'
' Notes:
' Any spaces in field names or table names will probably result in an error
' If this is the case then provide the brackets yourselfs, e.g.
' tLookup("My field","My table name with spaces in") will blow big time
' tLookup("[My field]","[My table name with spaces in]") will be ok
' These functions will not bracket the field/table names for you so as to
' remain as flexible as possible, e.g. you can call tSum() to add or multiply or
' whatever along the way, e.g. tSum("Price * Qty","Table","criteria") or if you're
' feeling adventurous, specify joins and the like in the table name.
'
' See tLookup function for changes from last version
'
' Uses DAO
'
' VB Users
' Get rid of tLookupParam() and the case in the error trapping
' of tLookup() that calls it, this uses a function built-in to
' MS-Access.

Public Enum tLookupReset
    tLookupDoNothing = 0
    tLookupRefreshDb = 1
    tLookupSetToNothing = 2
End Enum


Function tCount(pstrField As String, pstrTable As String, Optional pstrCriteria As String, Optional pdb As Database, Optional pLookupReset As tLookupReset = tLookupDoNothing) As Long
    
    ' Function tCount
    ' Purpose: Replace DCount, which is slow on attached tables
    ' Created: 1 Feb 1996 T.Best

    ' TB 28 Jan 2003
    ' Make this call TLookup() so we'll only need concentrate on
    ' one set of error handling code
    tCount = tLookup("count(" & pstrField & ")", pstrTable, pstrCriteria, pdb, pLookupReset)
    
End Function
Function tMax(pstrField As String, pstrTable As String, Optional pstrCriteria As String, Optional pdb As Database, Optional pLookupReset As tLookupReset = tLookupDoNothing) As Variant
    
    ' Function tMax
    ' Purpose: Replace DMax, which is slow on attached tables
    ' Created: 1 Feb 1996 T.Best

    ' TB 28 Jan 2003
    ' Make this call TLookup() so we'll only need concentrate on
    ' one set of error handling code
    tMax = tLookup("max(" & pstrField & ")", pstrTable, pstrCriteria, pdb, pLookupReset)
    Exit Function
End Function

Function tMin(pstrField As String, pstrTable As String, Optional pstrCriteria As String, Optional pdb As Database, Optional pLookupReset As tLookupReset = tLookupDoNothing) As Variant
    
    ' Function tMin
    ' Purpose: Replace DMin, which is slow on attached tables
    ' Created: 1 Feb 1996 T.Best
    
    ' TB 28 Jan 2003
    ' Make this call TLookup() so we'll only need concentrate on
    ' one set of error handling code
    tMin = tLookup("min(" & pstrField & ")", pstrTable, pstrCriteria, pdb, pLookupReset)
    
End Function

Function tSum(pstrField As String, pstrTable As String, Optional pstrCriteria As String, Optional pdb As Database, Optional pLookupReset As tLookupReset = tLookupDoNothing) As Double
    
    ' Function tSum
    ' Purpose: Replace DSum, which is slow on attached tables
    ' Created: 1 Feb 1996 T.Best

    ' TB 28 Jan 2003
    ' Make this call TLookup() so we'll only need concentrate on
    ' one set of error handling code
    tSum = Nz(tLookup("sum(" & pstrField & ")", pstrTable, pstrCriteria, pdb, pLookupReset), 0)

End Function


Function tLookup(pstrField As String, pstrTable As String, Optional pstrCriteria As String, Optional pdb As Database, Optional pLookupReset As tLookupReset = tLookupDoNothing) As Variant
    On Error GoTo tLookup_Err
    
    ' Function  tLookup
    ' Purpose:  Replace DLookup, which is slow on attached tables
    '           For where you can't use TbtLookup() if there's more
    '           than one field in the criteria or field is not indexed.
    ' Created:  9 Jan 1996 T.Best
    ' Mod       1 Feb 1996 T.Best
    '   Error Trapping brought in line with this procurement system.
    
    ' Mod       13 Apr 1999 T.Best
    '   Lookups to ODBC datasource use the gdbSQL database object.
    
    ' Mod       14 Apr 1999 T.Best
    '   gdbSQL object no good if doing lookup on a local table, DOH!
    
    ' Mod       11 Jan 2002 G.Hughes
    '   Removed gdbSQL as it was slowing tLookup Down.!!!!!!!!!
    
    ' Mod       Unlogged
    '   Someone put gdbSQL back in
    
    ' Mod       27 Jan 2003 T. Best
    '   Optimise gdbSQL to use Pass-through, it wickedly fast
    
    ' mod       13 Mar 2003
    '   Taken out gdbSQL for redistribution and replaced
    '   the DbEngine with CurrentDB to avoid the now well
    '   documented (in CDMA) DbEngine reference bug.
    '   Added tLookupReset Parameter which does the following
    '   tLookupDoNothing    Do nothing
    '   tLookupRefreshDb    Refreshes collections on the db
    '   tLookupCloseDb      Sets the db to nothing
    '   Also added a db parameter so programmer can call it using
    '   their own db variable, which may be something they opened
    '   elsewhere (Idea by D.Fenton in CDMA).
    
    Static dbLookup As DAO.Database
    Dim rstLookup As DAO.Recordset
    Dim varValue As Variant
    Dim strSQL As String
    
    ' if calling function sends a db then we'll use that
    If Not pdb Is Nothing Then
        Set dbLookup = pdb
    Else
        ' If our db vari is not initialised or the calling
        ' process wants the db objects refreshed then we'll
        ' set the db var using CurrentDb()
        If dbLookup Is Nothing Or pLookupReset = tLookupRefreshDb Then
            If Not dbLookup Is Nothing Then
                Set dbLookup = Nothing
            End If
            Set dbLookup = CurrentDb()
        End If
    End If
    
    
    ' If no criteria specified then we don't even want to get as far
    ' as putting the word "where" in there
    If Len(pstrCriteria) = 0 Then
        strSQL = "Select " & pstrField & " From " & pstrTable
    Else
        ' handle those instances where you call tLookup using a field
        ' on a form but can't be bothered to check whether it's null
        ' first before calling, e.g. =tLookup("col1","table","col2=" & txtWhatever)
        ' if txtWhatever was null it would cause an error, this way if there's
        ' nothing after the "=" sign then we assume it was null so we'll make
        ' it look for one.
        ' You may want to handle this differently and avoid looking up
        ' data where the criteria field is null and just always return a
        ' null in which case you'd need to add code to avoid doing the
        ' lookup altogether or just change the criteria to " = Null" as
        ' nothing will ever match with " = Null" so the function would
        ' return null.
        If Right(RTrim(pstrCriteria), 1) = "=" Then
            pstrCriteria = RTrim(pstrCriteria)
            pstrCriteria = Left(pstrCriteria, Len(pstrCriteria) - 1) & " is Null"
        End If
        
        ' build our SQL string
        strSQL = "Select " & pstrField & " From (" & pstrTable & ") Where " & pstrCriteria
    End If
    
    ' now open a recordset based on our SQL
    Set rstLookup = dbLookup.OpenRecordset(strSQL, dbOpenSnapshot, dbReadOnly)
    
    ' chekc if we returned anything at all
    If Not rstLookup.BOF Then
        ' return the value returned in the query
        varValue = rstLookup(0)
    Else
        ' no records matched, return a null
        varValue = Null
    End If
    tLookup = varValue

tLookup_Exit:
    On Error Resume Next
    rstLookup.Close
    Set rstLookup = Nothing
    Exit Function

tLookup_Err:
    Select Case Err
        Case 3061
            ' Error 3061 - Too Few Parameters - Expected x, you know those programmers
            ' should really parse out those form object references for themselves but
            ' we can try to retrieve the situation here by evaluating any parameters
            ' we find in the SQL string.
            tLookup = tLookupParam(strSQL, dbLookup)
        Case Else
            MsgBox Err.Description, 16, "Error " & Err & " in tLookup() on table " & pstrTable & vbCr & vbCr & "SQL=" & strSQL
        End Select
    Resume tLookup_Exit
    Resume

End Function

Function tLookupParam(pstrSQL As String, pdb As Database) As Variant
    ' Called when tLookup, tCount, tMax, tMin or tSum have bombed out
    ' with an expected parameter error, will go and create a querydef
    ' and then attempt to evaluate the parameters
    ' Error Trapped: 12/02/1999 10:21:24 Admin
    On Error GoTo tCountParam_Err
    Dim qdf As DAO.QueryDef
    Dim rsT As DAO.Recordset
    Dim prm As DAO.Parameter
    Dim strMsg As String
    Dim i As Long
    
    Set qdf = pdb.CreateQueryDef("", pstrSQL)
    strMsg = vbCr & vbCr & "SQL=" & pstrSQL & vbCr & vbCr
    For i = 0 To qdf.Parameters.count - 1 ' Each prm In qdf.Parameters
        Set prm = qdf.Parameters(i)
        strMsg = strMsg & "Param=" & prm.Name & vbCr
        prm.Value = Eval(prm.Name)
        Set prm = Nothing
    Next
    Set rsT = qdf.OpenRecordset()
    rsT.MoveFirst
    tLookupParam = rsT(0)
    
tCountParam_Exit:
    On Error Resume Next
    Set prm = Nothing
    rsT.Close
    Set rsT = Nothing
    qdf.Close
    Set qdf = Nothing
    Exit Function
    
tCountParam_Err:
    Select Case Err
        Case Else
            MsgBox Err.Description & strMsg, 16, "Error #" & Err & " In tLookupParam()"
    End Select
    Resume tCountParam_Exit
    Resume
End Function