Adding working days to a date (1 Viewer)

[ECEK]

I recently found a way of calculating how many working days ie M to F (and excluding holidays) there were between two dates by creating a function.

I am looking to add X number of working days to a set date (excluding a list of holidays).

Does anybody know of a function that I could use ?

An example:

I wish to add 10 working days to 19th December 2016
I have a list of all public holidays that land on a weekday in a table "tbl_hols"
In my table I have:


Boxing Day 26th December 2016
New Year Holiday 2nd January 2016

My result would therefore be :

4th January

Thanks for your advice you beautiful people !!

 

[Minty]

You can do this with a simple modification / copy of your existing function - so post it up!

 

[jdraw]

You may get some ideas from this sample

 

[gemma-the-husky]

personally, I tend to do it by brute force.
The holiday days is the tricky bit.

 newdate = startdate
 daysadded=0
 while daysadded<target
      newdate=newdate+1
      if weekday(newdate)<>vbsaturday and weekday(newdate)<>vbsunday and notaholiday(newdate) then daysadded = days added+1
 wend
  
 'newdate is the date you want

 

[ECEK]

OK Minty. This is what I have for calculating working days (M to F) including any dates that are in the Holidays Table.

You have to be careful when entering dates into the holiday table that they are weekdays. If you adda date that is on a weekend it will still be included in the final calculation.

Hope you can help.

As I explained: I want to add X number of working days to the startDate.

Public Function Workdays(ByRef startDate As Date, _
     ByRef endDate As Date, _
     Optional ByRef strHolidays As String = "Holidays" _
     ) As Integer
    ' Returns the number of workdays between startDate
    ' and endDate inclusive.  Workdays excludes weekends and
    ' holidays. Optionally, pass this function the name of a table
    ' or query as the third argument. If you don't the default
    ' is "Holidays".
    On Error GoTo Workdays_Error
    Dim nWeekdays As Integer
    Dim nHolidays As Integer
    Dim strWhere As String
    
    ' DateValue returns the date part only.
    startDate = DateValue(startDate)
    endDate = DateValue(endDate)
    
    nWeekdays = Weekdays(startDate, endDate)
    If nWeekdays = -1 Then
        Workdays = -1
        GoTo Workdays_Exit
    End If
    
    strWhere = "[Holiday] >= #" & startDate _
        & "# AND [Holiday] <= #" & endDate & "#"
    
    ' Count the number of holidays.
    nHolidays = DCount(Expr:="[Holiday]", _
        Domain:=strHolidays, _
        Criteria:=strWhere)
    
    Workdays = nWeekdays - nHolidays
    
Workdays_Exit:
    Exit Function
    
Workdays_Error:
    Workdays = -1
    MsgBox "Error " & Err.Number & ": " & Err.Description, _
        vbCritical, "Workdays"
    Resume Workdays_Exit
    
End Function

Public Function Weekdays(ByRef startDate As Date, _
    ByRef endDate As Date _
    ) As Integer
    ' Returns the number of weekdays in the period from startDate
    ' to endDate inclusive. Returns -1 if an error occurs.
    ' If your weekend days do not include Saturday and Sunday and
    ' do not total two per week in number, this function will
    ' require modification.
    On Error GoTo Weekdays_Error
    
    ' The number of weekend days per week.
    Const ncNumberOfWeekendDays As Integer = 2
    
    ' The number of days inclusive.
    Dim varDays As Variant
    
    ' The number of weekend days.
    Dim varWeekendDays As Variant
    
    ' Temporary storage for datetime.
    Dim dtmX As Date
    
    ' If the end date is earlier, swap the dates.
    If endDate < startDate Then
        dtmX = startDate
        startDate = endDate
        endDate = dtmX
    End If
    
    ' Calculate the number of days inclusive (+ 1 is to add back startDate).
    varDays = DateDiff(Interval:="d", _
        date1:=startDate, _
        date2:=endDate) + 1
    
    ' Calculate the number of weekend days.
    varWeekendDays = (DateDiff(Interval:="ww", _
        date1:=startDate, _
        date2:=endDate) _
        * ncNumberOfWeekendDays) _
        + IIf(DatePart(Interval:="w", _
        Date:=startDate) = vbSunday, 1, 0) _
        + IIf(DatePart(Interval:="w", _
        Date:=endDate) = vbSaturday, 1, 0)
    
    ' Calculate the number of weekdays.
    Weekdays = (varDays - varWeekendDays)
    
Weekdays_Exit:
    Exit Function
    
Weekdays_Error:
    Weekdays = -1
    MsgBox "Error " & Err.Number & ": " & Err.Description, _
        vbCritical, "Weekdays"
    Resume Weekdays_Exit
End Function

 

[Minty]

Okay so you can use your existing functions, along with Paul's brute force suggestion. You know the start date, add the number of days you are looking to add on to it to give you the first end date to test. if it's not the desired result add another one. Rinse and repeat.

So your new Function will be something like (Aircode - Untested)

Public Function AddWorkDays(DateStart as Date, iDays as Integer) as Date

Dim EndDate as Date

EndDate = DateStart + iDays

While WorkingDays(DateStart, EndDate, "Holidays") < iDays
	EndDate = EndDate + 1
Wend

AddWorkDays = EndDate

End Function

 

[jdraw]

A little late in posting, but I remember doing something with adding Days to a Date.
Found this function.

'---------------------------------------------------------------------------------------
' Procedure : EndDate
' Author    : Jack (via tektips)
' Date      : 28-09-2012
' Purpose   : To get an End date given a Start Date and a number of Days, with an
' option to include or exclude weekends. DOES NOT DEAL WITH HOLIDAYS.
'
'So, in general, if you exclude weekends, you are dealing with BusinessDays/workdays, BUT
'the routine DOES NOT DEAL WITH HOLIDAYS!!!
'---------------------------------------------------------------------------------------
' Last Modified:
'
' Inputs: N/A
' Dependency: N/A
'--------------------------------------------------------------------------
'
Function EndDate(StartDate As Date, _
                 AddDays As Long, _
                 IncludeWeekends As Boolean) As Date

      Dim n                           As Long
      Dim NextDate                    As Date
      Dim Step                        As Long
10       On Error GoTo EndDate_Error

20    If IncludeWeekends Then
30        EndDate = DateAdd("d", AddDays, StartDate)
40    Else
50        n = 0
60        Step = Sgn(AddDays)
70        NextDate = StartDate
80        Do Until n >= Abs(AddDays)
90            NextDate = NextDate + Step
100           If WeekDay(NextDate) <> vbSaturday And _
                 WeekDay(NextDate) <> vbSunday _
                 Then n = n + 1
110       Loop
120       EndDate = NextDate
130   End If

140      On Error GoTo 0
150      Exit Function

EndDate_Error:

160       MsgBox "Error " & Err.number & " (" & Err.Description & ") in procedure EndDate of Module AWF_Related"
End Function

 

[ECEK]

Minty: where do I put this code?
I've just appended it to the end of my code but it brings up errors!

 

[ECEK]

OK Guys I've found this:

This works a treat all I need now is to add the dates from my tbl_holiday table.

Can anybody modify this so I can just paste it back into my Module?

tbl_holidays.exdate will be the dates that need to be added.

Public Function AddWeekdays(datDateIn As Date, intDays As Integer) As Date
  ' Comments: Add or subtract a number of weekdays to a date.
  '           Weekend dates are not counted in adding/subtracting days.
  ' Params  : datDateIn       Starting date
  '           intDays         Number of days to add (negative to subtract)
  ' Returns : Original date plus the number of weekdays added
  ' Source  : Total Visual SourceBook

  On Error GoTo PROC_ERR

  Dim intCounter As Integer
  Dim intDirection As Integer
  Dim datNewDate As Date
  Dim lngWeeks As Long
  Dim intDaysLeft As Integer

  datNewDate = datDateIn

  If intDays > 0 Then
    intDirection = 1
  Else
    intDirection = -1
  End If
  lngWeeks = Fix(Abs(intDays) / 5)

  If lngWeeks > 0 Then
    datNewDate = datNewDate + lngWeeks * 7 * intDirection
  End If

  intDaysLeft = Abs(intDays) - lngWeeks * 5

  For intCounter = 1 To intDaysLeft
    datNewDate = datNewDate + 1 * intDirection
    If intDirection > 0 Then
      ' Increment date
      If Weekday(datNewDate) = 7 Then
        datNewDate = datNewDate + 2
      End If
    Else
      ' Decrement date
      If Weekday(datNewDate) = 1 Then
        datNewDate = datNewDate - 2
      End If
    End If
  Next intCounter

  AddWeekdays = datNewDate

PROC_EXIT:
  Exit Function

PROC_ERR:
  MsgBox "Error: " & Err.Number & ". " & Err.Description, , "modDateTime.AddWeekdays"
  Resume PROC_EXIT
End Function

 

[Minty]

Minty: where do I put this code?
I've just appended it to the end of my code but it brings up errors!

You would call it as another function, so either in a query or as an after update event to set another value somewhere.

 

[ECEK]

Minty. Are you able to add to my last code?

Anybody ?

 

[Minty]

You don't need it with your original working code, and the snippet I posted.
You already have the holidays accounted for in your first code.

Post up where you are getting the error using the code I posted (It is untested so I probably have a deliberate faux pas in there...)

 

[ECEK]

When I append your code onto the original and press compile it highlights WorkingDays in blue and says:

Public Function AddWorkDays(DateStart As Date, iDays As Integer) As Date

Dim EndDate As Date

EndDate = DateStart + iDays

While WorkingDays(DateStart, EndDate, "Holidays") < iDays
    EndDate = EndDate + 1
Wend

AddWorkDays = EndDate

End Function

Compile error
Sub or Function not defined

Should it say :

While Workdays(DateStart, EndDate, "Holidays") < iDays
EndDate = EndDate + 1


If that is right how do I use the function in a query?

NewDate:AddWorkDays([Mystartdate],[mydaystoadd]) ?

 

[ECEK]

I managed to get the AddWorkDays function to work but the result is wrong ?
It's as though it subtracts a day where it should add one on (if there is a holiday witthin the range)

 

[Minty]

You are on the right lines. Does your Workdays() function give you the correct result for any given dates??

 

[ECEK]

Actually I had noticed that Workdays() Function isn't working properly but I'm simply not capable of understanding where its going wrong?
On some dates it works and on others it doesn't.

Have you spotted an error?

Could we utilise this code:

Public Function AddWeekdays(datDateIn As Date, intDays As Integer) As Date
  ' Comments: Add or subtract a number of weekdays to a date.
  '           Weekend dates are not counted in adding/subtracting days.
  ' Params  : datDateIn       Starting date
  '           intDays         Number of days to add (negative to subtract)
  ' Returns : Original date plus the number of weekdays added
  ' Source  : Total Visual SourceBook

  On Error GoTo PROC_ERR

  Dim intCounter As Integer
  Dim intDirection As Integer
  Dim datNewDate As Date
  Dim lngWeeks As Long
  Dim intDaysLeft As Integer

  datNewDate = datDateIn

  If intDays > 0 Then
    intDirection = 1
  Else
    intDirection = -1
  End If
  lngWeeks = Fix(Abs(intDays) / 5)

  If lngWeeks > 0 Then
    datNewDate = datNewDate + lngWeeks * 7 * intDirection
  End If

  intDaysLeft = Abs(intDays) - lngWeeks * 5

  For intCounter = 1 To intDaysLeft
    datNewDate = datNewDate + 1 * intDirection
    If intDirection > 0 Then
      ' Increment date
      If Weekday(datNewDate) = 7 Then
        datNewDate = datNewDate + 2
      End If
    Else
      ' Decrement date
      If Weekday(datNewDate) = 1 Then
        datNewDate = datNewDate - 2
      End If
    End If
  Next intCounter

  AddWeekdays = datNewDate

PROC_EXIT:
  Exit Function

PROC_ERR:
  MsgBox "Error: " & Err.Number & ". " & Err.Description, , "modDateTime.AddWeekdays"
  Resume PROC_EXIT
End Function

 

[Minty]

Ah well - that's where we need to start, is it not working with the holidays or just generally?

If you post up some examples of inputs and the incorrect outputs I'm sure it should be easy to fix.

 

[ECEK]

Start Date, Number of Days to add,weekdays(),Workdays(),AddWorkDays()
27/05/2016, 5, 6, 6, 02/06/2016
27/05/2016, 10, 11, 10, 10/06/2016

In the holiday table there is one date 30/05/2016

It should read
Start Date, Number of Days to add,weekdays(),Workdays(),AddWorkDays()
27/05/2016, 5, 6, 6, 06/06/2016
27/05/2016, 10, 11, 10, 13/06/2016

Both entries should take into account the holiday (30/05/2016)
But the top entry is the same for both weekdays() and workdays()

Hope this is clear?

 

[Minty]

Okay - I think this is possibly due to a date formatting issue. You are using UK formatted dates, and the code is expecting US (mm/dd/yyyy) dates - at least in certain places where it's looking up the holidays in the code.

I currently don't have the time to correct it / test it, but a little research your end should get you to a solution.

Test each module individually. Then get to the last bit where it is adding the days on.
If I get time later / tomorrow I'll see what the problem is.

 

[ECEK]

I've had an idea.
Could you write a function that counts how many times a date (in the holiday table) appears between two dates?

I could figure it out then ?