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
getWorkingDaysUntilDate
vsgetWorkindDaysUntilDateDict
... one says working the otherworkinD
- too looong!!! :PGet
is for getting something, a dictionary should be justdaysTilDate
cause you already know the whole app is in context of the working days until date... \$\endgroup\$