Adding business days and holidays to a date.

ECEK

Registered User.
Local time
Today, 03:05
Joined
Dec 19, 2012
Messages
717
I have found this code that will add working or business days to a date.

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

Is it possible to add to this code (so that I can just paste it into my module) to look up dates from a holiday table and add those as well ?
 
No, I don't think you will find pastable code, you'll have to get your hands dirty a little unless...

You find code to do exactly what you want. I've seen this issue on this site a hundred times. Code is on this site to do exactly what you want with holidays too. I don't know exactly where, but I know I've seen it a bunch, so keep searching. Or, better yet, try and write it yourself, its not really too hard. If you want to play with VBA it would be a good spot to start.
 
Possibly the most rediculous reply I have ever come across. Help ? No, Informative? No, Patronising? Yes.

Imagine this site where every answer to any question was. Why not learn it yourself !!!

I'm trying but I keep meeting idiots on the way !!!

Anybody got anything proactive to add
 
I'll drop out of the conversation, but I think I have to defend myself a little:

I am excellent at being patronizing, condescending and giving backhanded compliments. I honestly wasn't trying to, so please don't judge my ability to do such things on that post alone. I can be way more of an a-hole when I try. You should have no trouble finding users on this site to back me up on that.
 
I know this is an old thread, but I'd like to offer my solution to this problem with the code below:

Code:
Public Function AddWeekdays(datDateIn As Date, intDays As Integer) As Date
 ' Modified from example at 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

  intDaysLeft = Abs(intDays)

For intCounter = 1 To intDaysLeft
    SQLHol = "SELECT Tbl_Holidays.Holiday_Date FROM Tbl_Holidays;"
    Set db = CurrentDb
    Set rs = db.OpenRecordset(SQLHol)
    rs.MoveFirst
    Do While Not rs.EOF
        If datNewDate = rs.Fields(0).value Then
            intCounter = intCounter - 1
            Exit Do
        End If
        rs.MoveNext
    Loop
    datNewDate = datNewDate + 1
    If Weekday(datNewDate) = 7 Then
  ys left      datNewDate = datNewDate + 2
    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


This relies on a static holiday table with date format of MM/DD/YYYY (other formats may work, so you'll have to try them) and simply compares every holiday date in the table to the current incremented date in the count. If there's a match, it subtracts 1 from the increment number, moves to the next day and continues to count up to the increment days left.

Hope that helps someone else.
 

Users who are viewing this thread

Back
Top Bottom