Is it possible to make this function more efficient?

[jonathanchye]

Hi all,

Basically I call this function in a query so at the moment the query runs pretty slow. Is there anyway to make this function more efficient? I am thinking of ditching DLookup in the loop but not sure how to do that...

Public Function NetWorkdays(dteStart As Date, dteEnd As Date) As Long
    Dim lngDate As Long
    
     If IsNull(dteStart) Or IsEmpty(dteStart) Or IsNull(dteEnd) Or IsEmpty(dteEnd) Then
     GoTo Exitpoint
     End If
     
   ' NetWorkdays = -1
    ' Check for valid dates.
    If IsDate(dteStart) And IsDate(dteEnd) Then
        ' Strip off any fractional days and just use whole days.
        For lngDate = Int(dteStart) To Int(dteEnd)
        
            If Weekday(lngDate, vbMonday) < 6 Then
               If IsNull(DLookup("[HolidayDate]", "tblHolidays", "[HolidayDate] = " & lngDate)) Then
                   NetWorkdays = NetWorkdays + 1
               End If
            End If
        Next lngDate
    End If
'
Exitpoint:
    Exit Function

End Function

 

[jonathanchye]

Found a solution which made the function run almost 50% faster

Public Function NetWorkdays(dteStart As Date, dteEnd As Date) As Long
    Dim lngDate As Long
    Dim rst As DAO.Recordset
    Dim dbs As DAO.Database
        
     If IsNull(dteStart) Or IsNull(dteEnd) Then
     GoTo Exitpoint
     End If
     
     Set dbs = CurrentDb
     Set rst = dbs.OpenRecordset("tblHolidays", dbOpenSnapshot)
     
   ' NetWorkdays = -1
    ' Check for valid dates.
    If IsDate(dteStart) And IsDate(dteEnd) Then
        ' Strip off any fractional days and just use whole days.
        For lngDate = Int(dteStart) To Int(dteEnd)
        
            If Weekday(lngDate, vbMonday) < 6 Then
                   rst.FindFirst "[HolidayDate] = #" & Format(lngDate, "mm\/dd\/yyyy") & "#"
                   If rst.NoMatch Then
                   NetWorkdays = NetWorkdays + 1
                   End If
              
            End If
        Next lngDate
    End If
  rst.Close
  Set rst = Nothing
  Set dbs = Nothing

Exitpoint:
   
    Exit Function

End Function