Workday

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 ;)

Code:

---

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:

Code:

---

        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

---

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

Code:

---

    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

---

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.

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 ;)

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

Code:

---

    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

Code:

---

        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)