• Status: Solved
• Priority: Medium
• Security: Public
• Views: 463

Calculate Work Days

In MS Access, is there a way to calculate the difference between today's date and 60 days in to the future but ONLY using weekdays?
0
patriotpacer
• 3
• 2
1 Solution

CIOCommented:
You can use this function:
``````Public Function ISO_WorkdayDiff( _
ByVal datDateFrom As Date, _
ByVal datDateTo As Date, _
Optional ByVal booExcludeHolidays As Boolean) _
As Long

' Purpose: Calculate number of working days between dates datDateFrom and datDateTo.
' Assumes: 5 or 6 working days per week. Weekend is (Saturday and) Sunday.
' May be freely used and distributed.

' 1999-04-23. Gustav Brock, Cactus Data ApS, Copenhagen
'             Option for 5 or 6 working days per week added.
' 2008-06-12. Option to exclude holidays from the count of workdays.
' 2011-06-08. Rewrite using Skip functions.

Const cbytWorkdaysOfWeek  As Byte = 5
' Name of table with holidays.
Const cstrTableHoliday    As String = "tblHoliday"
' Name of date field in holiday table.
Const cstrFieldHoliday    As String = "HolidayDate"

Dim booReverse            As Boolean
Dim booSameWeekend        As Boolean
Dim lngWeeks              As Long
Dim lngDays               As Long
Dim lngHolidays           As Long
Dim lngWorkdays           As Long
Dim strDateFrom           As String
Dim strDateTo             As String
Dim strFilter             As String

If WeekDay(datDateFrom, vbMonday) > cbytWorkdaysOfWeek And _
WeekDay(datDateTo, vbMonday) > cbytWorkdaysOfWeek Then
' Both dates are of the same weekend.
booSameWeekend = True
End If

Select Case DateDiff("d", datDateFrom, datDateTo)
Case 0
' Zero days.
Exit Function
Case 1
If booSameWeekend Then
' Both dates are of the same weekend.
Exit Function
End If
Case -1
If booSameWeekend Then
' Both dates are of the same weekend.
Exit Function
Else
booReverse = True
End If
Case Is < -1
' Negative count.
booReverse = True
Case Else
' Positive count.
End Select

' Adjust dates to skip weekends and holidays.
datDateFrom = DateSkipNoneWorkingday(datDateFrom, booReverse)
datDateTo = DateSkipNoneWorkingday(datDateTo, Not booReverse)

' Find count of full weeks.
lngWeeks = DateDiff("w", datDateFrom, datDateTo)
' Calculate number of working days between the two weekdays ignoring holidays.
lngDays = WeekDay(datDateTo, vbMonday) - WeekDay(datDateFrom, vbMonday) _
+ cbytWorkdaysOfWeek * DateDiff("ww", DateAdd("ww", lngWeeks, datDateFrom), datDateTo, vbMonday)

If booExcludeHolidays Then
strDateFrom = Format(datDateFrom, "yyyy\/mm\/dd")
strDateTo = Format(datDateTo, "yyyy\/mm\/dd")
strFilter = cstrFieldHoliday & " Between #" & strDateFrom & "# And #" & strDateTo & "# And Weekday(" & cstrFieldHoliday & ", 2) <= " & cbytWorkdaysOfWeek & ""
lngHolidays = IIf(booReverse, -1, 1) * DCount("*", cstrTableHoliday, strFilter)
End If
' Add number of working days between the weeks of the two dates.
' Deduct count of holidays.
lngWorkdays = lngDays + cbytWorkdaysOfWeek * lngWeeks - lngHolidays

ISO_WorkdayDiff = lngWorkdays

End Function

Public Function DateSkipNoneWorkingday( _
ByVal datDate As Date, _
Optional ByVal booReverse As Boolean) _
As Date

' Purpose: Calculate first working day following/preceding datDate.
'
' 2009-04-12. Gustav Brock, Cactus Data ApS, Copenhagen

Dim datNext As Date
Dim datTest As Date

datNext = datDate
Do
datTest = datNext
datNext = DateSkipHoliday(datTest, booReverse)
datNext = DateSkipWeekend(datNext, booReverse)
Loop Until DateDiff("d", datTest, datNext) = 0

DateSkipNoneWorkingday = datNext

End Function

Public Function DateSkipHoliday( _
ByVal datDate As Date, _
Optional ByVal booReverse As Boolean) _
As Date

' Purpose: Calculate first day following/preceding datDate if this is holiday.
'
' 2009-04-12. Gustav Brock, Cactus Data ApS, Copenhagen

Const cstrHolidayTable  As String = "tblHoliday"
Const cstrHolidayField  As String = "HolidayDate"

While Not IsNull(DLookup(cstrHolidayField, cstrHolidayTable, cstrHolidayField & " = " & Format(datDate, "\#m\/d\/yyyy\#")))
datDate = DateAdd("d", 1 - Abs(2 * booReverse), datDate)
Wend

DateSkipHoliday = datDate

End Function

Public Function DateSkipWeekend( _
ByVal datDate As Date, _
Optional ByVal booReverse As Boolean) _
As Date

' Purpose: Calculate first working day equal to or following/preceding datDate.
' Assumes: 5 or 6 working days per week. Weekend is (Saturday and) Sunday.
' Limitation: Does not count for public holidays.
'
' May be freely used and distributed.
' 1999-07-03, Gustav Brock, Cactus Data ApS, Copenhagen

Const cintWorkdaysOfWeek As Integer = 5

Dim bytSunday   As Byte
Dim bytWeekday  As Byte

bytSunday = WeekDay(vbSunday, vbMonday)
bytWeekday = WeekDay(datDate, vbMonday)

If bytWeekday > cintWorkdaysOfWeek Then
' Weekend.
If booReverse = False Then
' Get following workday.
datDate = DateAdd("d", 1 + bytSunday - bytWeekday, datDate)
Else
' Get preceding workday.
datDate = DateAdd("d", cintWorkdaysOfWeek - bytWeekday, datDate)
End If
End If

DateSkipWeekend = datDate

End Function
``````
/gustav
0

Author Commented:
Do I need this table?
tblHoliday
0

CIOCommented:
Not if you don't care for Holidays.

/gustav
0

Author Commented:
Thx.  I'll try it here shortly....
0

CIOCommented:
You can exclude that check:

Do
datTest = datNext
''''   datNext = DateSkipHoliday(datTest, booReverse)
datNext = DateSkipWeekend(datNext, booReverse)
Loop Until DateDiff("d", datTest, datNext) = 0

/gustav
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.