Workday

[Bruce Fox]

Hi All,

I needed a function similar to Excels WORKDAY to provide a Date in advance excluding Weekends (and Holidays [Optional]).

I tried a few methods, and ended up with this.

Simply build a list of Dates and iterate them removing Weekends and Holidays, then pick the number of days ahead. It is useful for forecasting graduation dates for a given course of length n. (Note, it is Aus centric)

Please comment

Option Explicit On
Option Strict On

    Public Function FindDate(ByVal startdate As Date, ByVal days As Integer, Optional ByVal holidays As List(Of Date) = Nothing) As Date
        ' *****************************************************
        ' Validate
        If days < 1 Then Err.Raise(vbObjectError + 513, "Module.ForcastDate.Limit", "Minimum number of 'days' exceeded. The allowed lower limit is 1.")
        If days > 2000 Then Err.Raise(vbObjectError + 2000, "Module.ForcastDate.Limit", "Maximum number of 'days' exceeded. The allowed maximum limit is 2000.")
        ' *****************************************************

        Dim dates As New List(Of Date)

        ' We need to ensure that enough Dates exist AFTER the Weekends and Holidays are removed so the 'days' ahead will hit a Date and not error out on 'Index out Of Range'
        ' Therefore, pad the offset out using the (arbitrary) functions below
        Dim offset As Integer
        If days < 6 Then
            offset = days + Convert.ToInt16(days * 2)
        Else
            offset = days + Convert.ToInt16(days * 0.5)
        End If
        If Not IsNothing(holidays) Then offset += Convert.ToInt16(holidays.Count * 2)

        Try
            For intCount = 0 To offset - 1 ' Include the startdate as the point to calculate from by indexing as "0 to n" days - 1
                dates.Add(DateAdd(DateInterval.Day, intCount, startdate).Date)
            Next
            ' Use LINQ to remove Weekends
            For Each _date In dates.Where(Function(i) i.Date.DayOfWeek = DayOfWeek.Saturday Or i.Date.DayOfWeek = DayOfWeek.Sunday).ToArray()
                dates.Remove(_date)
            Next
            ' Now, remove all Holidays
            If Not IsNothing(holidays) Then
                For Each _holiday In holidays
                    dates.Remove(_holiday.Date)
                Next
            End If

            Return dates.Item(days - 1)

        Catch ex As Exception
            ' Return an arbitary Date
            Return #1/1/1900#
        End Try

    End Function

Use:

        Dim workday As New clsWorkday

        Dim holidaylist As New List(Of Date)
        holidaylist.Add(Convert.ToDateTime("11/7/2012"))
        holidaylist.Add(Convert.ToDateTime("12/7/2012"))
        Try
            MessageBox.Show(FindDate(Convert.ToDateTime("09/7/2012").Date, 4, holidaylist).ToShortDateString)
           MessageBox.Show(FindDate(Convert.ToDateTime("09/7/2012").Date, 160).ToShortDateString)
        Catch ex As Exception
            MsgBox(ex.Message)
            MsgBox(ex.Source)
        End Try

[kleinma]

Same results with this refactored one. It could probably be tweaked even further.

    Public Function FindDate2(startdate As Date, days As Integer, Optional holidays As List(Of Date) = Nothing) As Date

        'VALIDATION
        If days < 1 Then Throw New ArgumentException("Minimum number of 'days' exceeded. The allowed lower limit is 1.")
        If days > 2000 Then Throw New ArgumentException("Maximum number of 'days' exceeded. The allowed maximum limit is 2000.")

        Dim dateIncrement As Date = startdate 'USED TO INCREMENT THE DATE FORWARD

        Do Until days = 0 'LOOP UNTIL WE HAVE USED ALL THE NEEDED DAYS
            dateIncrement = dateIncrement.AddDays(1) 'GET THE NEXT DAY SO IT CAN BE TESTED TO BE A WEEKEND OR HOLIDAY
            If dateIncrement.DayOfWeek = DayOfWeek.Saturday OrElse
                dateIncrement.DayOfWeek = DayOfWeek.Sunday OrElse (holidays IsNot Nothing AndAlso holidays.Contains(dateIncrement)) Then
                Continue Do 'WEEKEND OR PASSED IN HOLIDAY, GO ON TO NEXT DAY
            Else
                days -= 1 'A WEEKDAY WAS FOUND, DECREMENT DAYS COUNTER BY 1
            End If
        Loop

        Return dateIncrement.AddDays(-1) 'RETURN THE FINAL DATE WE GOT TO (-1)

    End Function

[Bruce Fox]

Hi kleinma,

Thanks for the feedback and tweaks

Unfortunately, 'FindDate2' exhibits the same issue of not aggregating days, weekend & holidays to provide the calculated offset to jump forward.

I had the same problem (except I was using recursion) to pass back the intermediate Date in case it fell on a Weekend/Holiday.

To demonstrate, take this example:
Start Date is: Monday 09 July 2012, number of days to complete the Course is 10.


09/July/2012, 10 days ahead is Friday the 20th July 2012. ('FindDate2' yields 22nd July 2012)

At least you provided something better to work with, I think I have a fix (using FindDate2) and I will post back later today.

[Bruce Fox]

Matt,

I'll apologise now, as I think I wasn't clear, and confussed the issue using the word 'exclude'!

What I should have stated, was that a StartDate is provided, and the length of Course in days (n) is provided.

The Function, needs to return the Date that is n days ahead 'discounting/passing by' Weekends (and Holidays).

In other words, Weekend and Holidays cannot be absorbed as a Course day, just working days.


My bad

[Bruce Fox]

For now, I have reverted back to the table approach. It is still slightly wasteful due to the padding, but I have tried small lengths, and large ones successfully (for example in a year, approx 1/3 of the days are weekends):

    Public Function GraduationDate(ByVal startdate As Date, ByVal courselength As Integer, Optional ByVal holidays As List(Of Date) = Nothing) As Date
        ' *****************************************************
        ' Validate
        If startdate.DayOfWeek = DayOfWeek.Saturday OrElse startdate.DayOfWeek = DayOfWeek.Sunday OrElse
            (holidays IsNot Nothing AndAlso holidays.Contains(startdate)) Then Throw New ArgumentException("The Start Date must be a Weekday.")
        If courselength < 1 Then Throw New ArgumentException("Minimum Course Length exceeded. The allowed lower limit is 1.")
        If courselength > 2000 Then Throw New ArgumentException("Maximum Course Length exceeded. The allowed upper limit is 2000.")
        ' *****************************************************
        Dim dates As New List(Of Date)

        ' We need to ensure that enough Dates exist AFTER the Weekends and Holidays are removed so the 'courselength' ahead will hit a Date
        Dim offset As Integer = (courselength + holidays.Count) * 2

        dates.Add(DateAdd(DateInterval.Day, 1, startdate).Date)  ' Include the Start Date

        For intCount = 1 To offset
            startdate = startdate.AddDays(1)
            If startdate.DayOfWeek <> DayOfWeek.Saturday AndAlso
                startdate.DayOfWeek <> DayOfWeek.Sunday AndAlso
                Not (holidays IsNot Nothing AndAlso holidays.Contains(startdate)) Then
                dates.Add(startdate.Date)
            End If
        Next

        Return dates.Item(courselength - 1)

    End Function

Calling

        Dim holidaylist As New List(Of Date)
        holidaylist.Add(Convert.ToDateTime("10/7/2012"))
        holidaylist.Add(Convert.ToDateTime("11/7/2012"))
        holidaylist.Add(Convert.ToDateTime("13/7/2012"))
        Try
            MessageBox.Show(GraduationDate(Convert.ToDateTime("09/7/2012").Date, 3, holidaylist).ToShortDateString)
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try

(Note: If using Excel to validate, the course length needs to be n-1 as Excel does not include the start date)