Access function to return "number of working days until date" for form

Question

I need a function I can put on a form which does:

• Calculates number of working days until a given date
• Excludes weekends
• Excludes any dates in a "holiday" table

This is replacing something which looks like:

 =DateDiff("d",Now(),[DateEstimatedDesignStartBy])

with

 =getWorkingDaysUntilDate([DateEstimatedDesignStartBy])

The below is a all within a single module I am using to do this.

I am reading in the entire table of holidays and caching it, and then iterating until teh required date to find the number of days and then caching this result as well.

The net result is a much faster function than having to do the calculation for each time I do anything.

Any feedback would be great. I have a lot of poor naming but am not really sure what would be good...

It seems a bit slower than what it is replacing.

Option Compare Database
Option Explicit


Private m_HolidayLibrary As Scripting.Dictionary
Private m_WorkingDaysUntilDate As Scripting.Dictionary

Public Function getWorkingDaysUntilDate(p_date As Date) As Integer

    If getWorkindDaysUntilDateDict.exists(p_date) = False Then
        getWorkindDaysUntilDateDict.Add p_date, calculateWorkingDaysUntilDate(p_date)
    End If

    getWorkingDaysUntilDate = getWorkindDaysUntilDateDict(p_date)
End Function
Private Function getWorkindDaysUntilDateDict() As Scripting.Dictionary

    If m_WorkingDaysUntilDate Is Nothing Then
        Set m_WorkingDaysUntilDate = New Scripting.Dictionary

    End If

    Set getWorkindDaysUntilDateDict = m_WorkingDaysUntilDate


End Function
Private Function calculateWorkingDaysUntilDate(p_date As Date) As Integer

    Dim iteratedDate As Date
    iteratedDate = Date
    calculateWorkingDaysUntilDate = 0

    Do Until iteratedDate >= p_date
        calculateWorkingDaysUntilDate = calculateWorkingDaysUntilDate + 1

        Do
            iteratedDate = DateAdd("d", 1, iteratedDate)
            If isDateValidAdd(iteratedDate) Then Exit Do
        Loop

    Loop

End Function


Private Function isDateValidAdd(p_date As Date) As Boolean
    isDateValidAdd = True

    If getHolidayLibrary.exists(p_date) Then
        isDateValidAdd = False
    'saturdays
    ElseIf Weekday(p_date, vbSaturday) = 1 Then
        isDateValidAdd = False
    'sunday
    ElseIf Weekday(p_date, vbSaturday) = 2 Then
        isDateValidAdd = False
    End If



End Function

Private Function getHolidayLibrary() As Scripting.Dictionary

    If m_HolidayLibrary Is Nothing Then
        Set m_HolidayLibrary = createHolidayLibrary
    End If

    Set getHolidayLibrary = m_HolidayLibrary


End Function
Private Function createHolidayLibrary() As Scripting.Dictionary

   Dim rs As ADODB.Recordset
   Set rs = New ADODB.Recordset
   Set createHolidayLibrary = New Scripting.Dictionary

   rs.Open "eHolidays", CurrentProject.Connection, , adLockReadOnly

   Do Until rs.EOF
        createHolidayLibrary.Add CDate(rs.fields("Holiday")), rs.fields("HolidaysID")
        rs.MoveNext
   Loop

End Function

Answer 1

Don't compare a Boolean expression with a Boolean value to make.. a Boolean expression - the syntax for If blocks goes If {Boolean Expression} Then - therefore, = False is unnecessary here:

If getWorkindDaysUntilDateDict.exists(p_date) = False Then

The IsDateValid function can be simplified:

isDateValidAdd = True

If getHolidayLibrary.exists(p_date) Then
    isDateValidAdd = False
'saturdays
ElseIf Weekday(p_date, vbSaturday) = 1 Then
    isDateValidAdd = False
'sunday
ElseIf Weekday(p_date, vbSaturday) = 2 Then
    isDateValidAdd = False
End If

Is logically equivalent to :

Dim wkDayForDate Integer
wkDayForDate = Weekday(p_date, vbSaturday)

IsDateValidAdd = Not (GetHolidayLibrary.Exists(p_date) Or wkDayForDate = 1 Or wkDayForDate = 2)

Now because VBA will not short-circuit, one may argue that the long-winded If..ElseIf block will perform better... but comparing {Integer} = {value} isn't exactly an expensive operation, so I wouldn't worry about not short-circuiting.

If anything you may want to avoid accessing GetHolidayLibrary when Weekday(p_date, vbSaturday) is 1 or 2, so this:

Dim wkDayForDate Integer
wkDayForDate = Weekday(p_date, vbSaturday)

If Not (wkDayForDate = 1 Or wkDayForDate = 2) Then
    IsDateValidAdd = Not GetHolidayLibrary.Exists(p_date)
End If

Might just be the best compromise.

"Is date valid add" isn't exactly a great name. Assuming it means "can this date be added?", it could be renamed to CanAddDate, or perhaps IsWorkday.

Procedure names should be PascalCase, and I would drop the p_ prefix for parameters and the m_ prefix for fields.

---

Private Function getHolidayLibrary() As Scripting.Dictionary

    If m_HolidayLibrary Is Nothing Then
        Set m_HolidayLibrary = createHolidayLibrary
    End If

    Set getHolidayLibrary = m_HolidayLibrary


End Function

This looks like you're trying to "encapsulate" the dictionary with a getter... but in the same scope as the rest. You could have a class responsible for this encapsulation, and then the module wouldn't have to care about whether the holidays are loaded; CreateHolidayLibrary (which is really LoadHolidays or, in the case of a hypothetical HolidayLibrary class, simply Load or Refresh) would belong there as well.