Looking for a more effective and efficient way of working with large recordset

Question

I've created a public function in Access. My goal is if the next business day is a holiday I'm calculating one extra day of interest for payoff purposes. Below is the working code I have. The issue I'm haveing is I'm dealing with over 35000 records and the time it takes to run the query is too long. If there is a better way of do this I will definitely give it a try. Thanks!

Public Function HolidayInterest(Perdiem As Currency) As Currency
Dim db As Database
Dim rst As Recordset

Select Case DatePart("w", Date)
    Case 6
        NextBusDay = Date + 3
    Case 7
        NextBusDay = Date + 2
    Case Else
        NextBusDay = Date + 1
End Select

Set db = CurrentDb
Set rst = db.OpenRecordset("tbl_Holidays", dbOpenDynaset)

If Not (rst.EOF And rst.BOF) Then
Do While Not rst.EOF
    If rst("HolidayDate") = NextBusDay Then
            HolidayInterest = Perdiem
    Else
            HolidayInterest = 0
    End If
rst.MoveNext
    Loop
Else
    'MsgBox "There are no records in the recordset."
End If

'MsgBox "Finished looping through records."

rst.Close 'Close the recordset
Set rst = Nothing 'Clean up
db.Close
Set db = Nothing
End Function  

Answer 1

Apart from the Perdiem value you pass as an argument to your function, the only thing that will affect the return value of your function is the current system date as returned by Date. In other words, on any given day your function will always return either the Perdiem value or zero.

Therefore, we can use a Static variable named TheDateToday to hold the current date and you will only have to hit the [tbl_Holidays] table once on any given day:

Option Compare Database
Option Explicit

Public Function HolidayInterest(Perdiem As Currency) As Currency
    Dim db As DAO.Database, qdf As DAO.QueryDef, rst As DAO.Recordset
    Dim NextBusDay As Date
    Static TheDateToday As Date, NextBusDayIsHoliday As Boolean

    If CLng(TheDateToday) <> CLng(Date) Then
        TheDateToday = Date
        Select Case DatePart("w", TheDateToday)
            Case 6
                NextBusDay = DateAdd("d", 3, TheDateToday)
            Case 7
                NextBusDay = DateAdd("d", 2, TheDateToday)
            Case Else
                NextBusDay = DateAdd("d", 1, TheDateToday)
        End Select

        Set db = CurrentDb
        Set qdf = db.CreateQueryDef("", _
                "PARAMETERS prmDate DateTime;" & _
                "SELECT * FROM tbl_Holidays WHERE HolidayDate=[prmDate]")
        qdf!prmDate = NextBusDay
        Set rst = qdf.OpenRecordset(dbOpenSnapshot)

        NextBusDayIsHoliday = Not (rst.EOF And rst.BOF)

        rst.Close
        Set rst = Nothing
        Set qdf = Nothing
        Set db = Nothing
    End If

    If NextBusDayIsHoliday Then
        HolidayInterest = Perdiem
    Else
        HolidayInterest = 0
    End If
End Function

Answer 2

Here is one solution to avoid the opening the Holiday table 35,000 times. It will load all dates into an Array (only once), then use that array for comparing. But I am curious if your existing process ever worked correctly 100% of the time -- if that table contained more than one holiday? Specifically, when you read the holiday table (regardless of the sort order), then in your loop "If rst("HolidayDate") = NextBusDay Then", since you don't exit the loop if you get a match, your subroutine should always return the results of what happens when checking the last date in the table? Also I didn't find a Dim for NextBusDay, so I added it.

Option Compare Database
Option Explicit

Public blnSetArray  As Boolean
Public dHolidays()  As Date
Public iHolidays    As Integer

Public Function HolidayInterest(Perdiem As Currency) As Currency
Dim db  As Database
Dim rst As Recordset
Dim i   As Integer
Dim iLoop   As Integer
Dim NextBusDay  As Date

    ' Save an array of dates the first time
    If blnSetArray = False Then
        Set db = CurrentDb
        Set rst = db.OpenRecordset("tbl_Holidays", dbOpenDynaset)
        i = 0
        If Not (rst.EOF And rst.BOF) Then
            rst.MoveLast
            rst.MoveFirst
            iHolidays = rst.RecordCount
            ReDim dHolidays(rst.RecordCount)
            Do While Not rst.EOF
                i = i + 1
                dHolidays(i) = rst("HolidayDate")
                rst.MoveNext
            Loop
        End If
        blnSetArray = True
        rst.Close 'Close the recordset
        Set rst = Nothing 'Clean up
        db.Close
        Set db = Nothing
    End If

    Select Case DatePart("w", Date)
        Case 6
            NextBusDay = Date + 3
        Case 7
            NextBusDay = Date + 2
        Case Else
            NextBusDay = Date + 1
    End Select

    HolidayInterest = 0     ' Set as default

    If iHolidays > 0 Then
        For iLoop = 1 To iHolidays
            If dHolidays(iLoop) = NextBusDay Then
                HolidayInterest = Perdiem
                Exit For        ' No need to stay in loop
            End If
        Next iLoop
    Else
        'MsgBox "There are no records in the recordset."
    End If

'MsgBox "Finished looping through records."

End Function
Function MyTest()
    blnSetArray = False
    Debug.Print HolidayInterest(100#)

End Function