Improve Performance for Form With Many Dlookups

[Whizbang]

I was requested to improve a timesheet form that currently resides in Excel. The main goal is ease of use. I had the brilliant idea of moving it ot Access because then I could combine it with other forms that are used and make it a one-stop shop. I then had another brilliant idea of making a form with a calendar on it.

The attached is the result, so far.

The problem I am having is that in order to make the form appear as a calendar, I had to include 42 days (6 weeks with 7 days per week). Each day displays the day, the Hours Absent and the Reason Code for the absence. This gives me 146 controls in the calendar, 84 of which use DLookup.

It is not unbearably slow, but it is noticeably slow, and some users may get frustrated.

Is there any way I can avoid the Dlookups? Some magic SQL statement or VBA solution?

I tried this sub to clear the controls and assign values, but it is slower than the DLookup method.

Sub UpdateExemptTimesheet()
 
    Dim Ctrl As Control
    Dim db As Database
    Dim rs As DAO.Recordset
 
    'Clear controls
        For Each Ctrl In Forms!frmExemptTimesheetRequest.Controls
            If Ctrl.Name Like "txtDay*" Then
                Forms!frmExemptTimesheetRequest.Controls("txtHoursDay" & Mid(Ctrl.Name, 7, Len(Ctrl.Name) - 6)).ControlSource = ""
                Forms!frmExemptTimesheetRequest.Controls("txtReasonDay" & Mid(Ctrl.Name, 7, Len(Ctrl.Name) - 6)).ControlSource = ""
            End If
        Next Ctrl
 
    Set db = CurrentDb()
    Set rs = db.OpenRecordset("SELECT tblExemptTimeSheetAbsences.[Time ID], tblExemptTimeSheetAbsences.[Request ID], tblExemptTimeSheetAbsences.[Date of Absence], tblExemptTimeSheetAbsences.[Hours Absent], tblExemptTimeSheetAbsences.[Reason Code] FROM tblExemptTimeSheetAbsences WHERE (((tblExemptTimeSheetAbsences.[Request ID])=" & [Forms]![frmExemptTimesheetRequest]![Request ID] & "));", dbOpenDynaset)
 
        For Each Ctrl In Forms!frmExemptTimesheetRequest.Controls
            If Ctrl.Name Like "txtDay*" Then
                rs.FindFirst ("[Date of Absence] = #" & Ctrl.Value & "#")
                If Not rs.NoMatch Then
                    Forms!frmExemptTimesheetRequest.Controls("txtHoursDay" & Mid(Ctrl.Name, 7, Len(Ctrl.Name) - 6)).ControlSource = "=" & rs.Fields("[Hours Absent]").Value
                    Forms!frmExemptTimesheetRequest.Controls("txtReasonDay" & Mid(Ctrl.Name, 7, Len(Ctrl.Name) - 6)).ControlSource = "=""" & rs.Fields("[Reason Code]").Value & """"
                End If
            End If
        Next Ctrl
 
    rs.Close
    Set rs = Nothing
End Sub

Cross Post:
http://www.excelforum.com/access-tab...-dlookups.html

[Rawb]

The easiest solution would be to go snag a copy of the ELookup function and use it instead of DLookup. I haven't used it in a while (I try and stay away from DLookup, DCount, etc. on general principles) but from what I remember, my Forms loaded 2-3 times faster after switching from DLookup to ELookup.

The other option is to load Recordsets in VBA and do the lookup manually. This would drastically increase performance because you'd only be opening a Recordset a handful of times instead of every time ELookup/DLookup is called.

[Rawb]

P.S.
Looking back at your included code, I'm not sure what's going on. That code of your should have been WAY faster than using DLookups, not slower :/

[Whizbang]

Thank you for looking at this. Your last comment made me re-test the code above. Evidently what was slowing it down was this:

    'Clear controls
        For Each Ctrl In Forms!frmExemptTimesheetRequest.Controls
            If Ctrl.Name Like "txtDay*" Then
                Forms!frmExemptTimesheetRequest.Controls("txtHoursDay" & Mid(Ctrl.Name, 7, Len(Ctrl.Name) - 6)).ControlSource = ""
                Forms!frmExemptTimesheetRequest.Controls("txtReasonDay" & Mid(Ctrl.Name, 7, Len(Ctrl.Name) - 6)).ControlSource = ""
            End If
        Next Ctrl

This was clearing the ControlSource for all 84 fields. This wasn't necessary. I only need clear the ones that actually have a string in the control source. So I modified it and it runs MUCH faster.


The revised code is:

Sub UpdateExemptTimesheet()
    Dim Ctrl As Control
    Dim db As Database
    Dim rs As DAO.Recordset
    With Forms!frmExemptTimesheetRequest
        'Clear the Controls
        For Each Ctrl In .Controls
            If Ctrl.Name Like "txtHoursDay*" Or Ctrl.Name Like "txtReasonDay*" Then
                If Ctrl.ControlSource <> "" Then
                    Ctrl.ControlSource = ""
                End If
            End If
        Next Ctrl
 
        'Add any matching values
        If Not IsNull(.[Request ID]) Then
            Set db = CurrentDb()
            Set rs = db.OpenRecordset("SELECT tblExemptTimeSheetAbsences.[Time ID], tblExemptTimeSheetAbsences.[Request ID], tblExemptTimeSheetAbsences.[Date of Absence], tblExemptTimeSheetAbsences.[Hours Absent], tblExemptTimeSheetAbsences.[Reason Code] FROM tblExemptTimeSheetAbsences WHERE (tblExemptTimeSheetAbsences.[Request ID]=" & [Forms]![frmExemptTimesheetRequest]![Request ID] & ");", dbOpenDynaset)
            For Each Ctrl In .Controls
                If Ctrl.Name Like "txtDay*" Then
                    rs.FindFirst ("[Date of Absence] = #" & Ctrl.Value & "#")
                    If Not rs.NoMatch Then
                        .Controls("txtHoursDay" & Mid(Ctrl.Name, 7, Len(Ctrl.Name) - 6)).ControlSource = "=" & rs.Fields("[Hours Absent]").Value
                        .Controls("txtReasonDay" & Mid(Ctrl.Name, 7, Len(Ctrl.Name) - 6)).ControlSource = "=""" & rs.Fields("[Reason Code]").Value & """"
                    End If
                End If
            Next Ctrl
            rs.Close
            Set rs = Nothing
            Set db = Nothing
        End If
    End With
 
End Sub

The attached database is the updated version.