Go Premium for a chance to win a PS4. Enter to Win

x
?
Solved

Calculate Work Days

Posted on 2013-05-28
5
Medium Priority
?
448 Views
Last Modified: 2013-05-28
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
Comment
Question by:patriotpacer
  • 3
  • 2
5 Comments
 
LVL 52

Accepted Solution

by:
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

Open in new window

/gustav
0
 

Author Comment

by:patriotpacer
ID: 39201673
Do I need this table?
tblHoliday
0
 
LVL 52

Expert Comment

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

/gustav
0
 

Author Comment

by:patriotpacer
ID: 39201805
Thx.  I'll try it here shortly....
0
 
LVL 52

Expert Comment

by:Gustav Brock
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

Free learning courses: Active Directory Deep Dive

Get a firm grasp on your IT environment when you learn Active Directory best practices with Veeam! Watch all, or choose any amount, of this three-part webinar series to improve your skills. From the basics to virtualization and backup, we got you covered.

Question has a verified solution.

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

You need to know the location of the Office templates folder, so that when you create new templates, they are saved to that location, and thus are available for selection when creating new documents.  The steps to find the Templates folder path are …
Microsoft Access has a limit of 255 columns in a single table; SQL Server allows tables with over 255 columns, but reading that data is not necessarily simple.  The final solution for this task involved creating a custom text parser and then reading…
In Microsoft Access, learn how to “cascade” or have the displayed data of one combo control depend upon what’s entered in another. Base the dependent combo on a query for its row source: Add a reference to the first combo on the form as criteria i…
In Microsoft Access, learn different ways of passing a string value within a string argument. Also learn what a “Type Mis-match” error is about.

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

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

Join & Ask a Question