Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
Solved

# Calculate Work Days

Posted on 2013-05-28
Medium Priority
451 Views
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
Question by:patriotpacer
• 3
• 2

LVL 52

Accepted Solution

Gustav Brock earned 2000 total points
ID: 39201616
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
' 2000-10-03. Constants added.
'             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

' Adjust to fit your table of holidays.
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 Comment

ID: 39201673
Do I need this table?
tblHoliday
0

LVL 52

Expert Comment

ID: 39201741
Not if you don't care for Holidays.

/gustav
0

Author Comment

ID: 39201805
Thx.  I'll try it here shortly....
0

LVL 52

Expert Comment

ID: 39201984
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

## Featured Post

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

I have had my own IT business for a very long time. I started mostly with hardware and after about a year started to notice a common theme. I had shelves with software boxes -- Peachtree, Quicken, Sage, Ouickbooks -- and yet most of my clients were…
This article shows how to get a list of available printers for display in a drop-down list, and then to use the selected printer to print an Access report or a Word document filled with Access data, using different syntax as needed for working with …
In Microsoft Access, learn the trick to repeating sub-report headings at the top of each page. The problem with sub-reports and headings: Add a dummy group to the sub report using the expression =1: Set the “Repeat Section” property of the dummy…
The Relationships Diagram is a good way to get an overall view of what a database is keeping track of. It is also where relationships are defined. A relationship specifies how two tables connect to each other. As you build tables in Microsoft Ac…
###### Suggested Courses
Course of the Month13 days, 17 hours left to enroll

#### 580 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.