Calculate no of working days excluding bank holidays

M

madhouse

Registered User.
Local time
Today, 17:45
Joined
Jul 3, 2002
Messages
65
I'm creating a database for a cheque cashing service and need to calculate the what the day will be 4 working days from the current date. Now I need to exclude Saturdays, Sundays and all the UK bank holidays:

New Years Day
Good Friday
Easter Monday
May Bank Holiday
Spring Bank Holiday
Summer Bank Holiday
Christmas Day
Boxing Day

Obviously with Christmas Day, Boxing Day & New Years Day, if they fall on a Saturday or Sunday then the actual days we would have off work will be carried forward to the next working day e.g. Christmas Day & Boxing Day (25th & 26th) fall on a Saturday and Sunday this year, so we will be off work on the 27th and 28th.

Now I've found a post (http://www.access-programmers.co.uk/forums/showthread.php?t=54510&highlight=bank+holidays)where Mile-O-Phile posted an example of how to do this. However, it doesn't deal with the above where if Christmas Day, Boxing Day and New Years Eve fall on a Saturday or Sunday. I've had a look at Mile-O-Philes code but haven't got a clue how I would change it. Any ideas?
 
Have you tried looking here?

If that is not what you are looking for... I am sure your addaption is not that complex, tho not standaard.....

This shifts 1 day (like New years)
Code: 
Function ShiftToWorkday(someDate As Date) As Date
    If WeekDay(someDate, vbMonday) = 6 Then someDate = someDate + 2
    If WeekDay(someDate, vbMonday) = 7 Then someDate = someDate + 1
    ShiftToWorkday = someDate
End Function

But it gets a bit more complex for X-mass and boxing... I will have to give that some more thought... But you could do something simular...

Regards
 
Thanks for the reply.

I looked at the calendar example db but it didn't really help.

Your solution is something along the lines of what I was looking at doing myself, but like you I'm having trouble trying to work out how to deal with Christmas Day and Boxing Day :confused:
 
See if this modification to the code on the link you provided works:

Code: 
Option Compare Database
Option Explicit

Public Enum Dates
    vbNewYear = 1
    vbChristmas = 2
    vbBoxingDay = 3
End Enum

Public Function AddWorkingDays(ByVal dteStartDate As Date, _
    ByVal intDays As Integer) As Date
    Dim dteTemp As Date
    dteTemp = dteStartDate
    Do While intDays <> 0
        Select Case Weekday(dteTemp)
            Case Is = 1, 7
            Case Else
                Select Case dteTemp
                    Case Is = CorrectDate(DateSerial(Year(dteTemp), 1, 1)), _
                        DateOfEaster(Year(dteTemp)) - 2, _
                        DateOfEaster(Year(dteTemp)) + 1, _
                        GetBankHoliday(DateSerial(Year(dteTemp), 5, 1)), _
                        GetBankHoliday(DateSerial(Year(dteTemp), 5, 25)), _
                        GetBankHoliday(DateSerial(Year(dteTemp), 8, 25)), _
                        CorrectDate(DateSerial(Year(dteTemp), 12, 25)), _
                        CorrectDate(DateSerial(Year(dteTemp), 12, 26))
                    Case Else
                        intDays = intDays - 1
                End Select
        End Select
        dteTemp = dteTemp + 1
    Loop
    AddWorkingDays = dteTemp - 1
End Function

Public Function CorrectDate(dteTemp As Date, intHoliday As Dates) As Date

    Select Case intHoliday
        Case vbNewYear
            If Weekday(DateSerial(Year(dteTemp), 1, 1)) = 7 Then
                CorrectDate = DateSerial(Year(dteTemp), 1, 3)
            ElseIf Weekday(DateSerial(Year(dteTemp), 1, 1)) = 1 Then
                CorrectDate = DateSerial(Year(dteTemp), 1, 2)
            Else
                CorrectDate = DateSerial(Year(dteTemp), 1, 1)
            End If
        Case vbChristmas
            If Weekday(DateSerial(Year(dteTemp), 12, 25)) = 7 Or _
                Weekday(DateSerial(Year(dteTemp), 12, 25)) Then
                CorrectDate = DateSerial(Year(dteTemp), 12, 27)
            Else
                CorrectDate = DateSerial(Year(dteTemp), 12, 25)
            End If
        Case vbBoxingDay
            If Weekday(DateSerial(Year(dteTemp), 12, 26)) = 7 Or _
                Weekday(DateSerial(Year(dteTemp), 12, 26)) Then
                CorrectDate = DateSerial(Year(dteTemp), 12, 28)
            Else
                CorrectDate = DateSerial(Year(dteTemp), 12, 25)
            End If
    End Select

End Function


Public Function DateOfEaster(ByVal intYear As Integer) As Date
    Dim intDominical As Integer, intEpact As Integer, intQuote As Integer
    intDominical = 225 - (11 * (intYear Mod 19))
    If intDominical > 50 Then
        While intDominical > 50
            intDominical = intDominical - 30
        Wend
    End If
    If intDominical > 48 Then intDominical = intDominical - 1
    intEpact = (intYear + Int(intYear / 4) + intDominical + 1) Mod 7
    intQuote = intDominical + 7 - intEpact
    If intQuote > 31 Then
        DateOfEaster = DateSerial(intYear, 4, intQuote - 31)
    Else
        DateOfEaster = DateSerial(intYear, 3, intQuote)
    End If
End Function

Public Function GetBankHoliday(ByRef dteBankHoliday As Date) As Date
    Dim intCounter As Integer
    For intCounter = 0 To 6
        If Weekday(dteBankHoliday + intCounter) = 2 Then
            dteBankHoliday = dteBankHoliday + intCounter
            Exit For
        End If
    Next intCounter
    GetBankHoliday = dteBankHoliday
End Function
 
Mile-O-Phile,

Thanks for the changes but when I call AddWorkingDays with the correct parameters I get a 'Compile Error: Argument not optional' and the following is highlighted in the code....

Code: 
Public Function AddWorkingDays(ByVal dteStartDate As Date, _
    ByVal intDays As Integer) As Date
    Dim dteTemp As Date
    dteTemp = dteStartDate
    Do While intDays <> 0
        Select Case Weekday(dteTemp)
            Case Is = 1, 7
            Case Else
                Select Case dteTemp
Case Is = [B][COLOR=Red]CorrectDate[/COLOR][/B](DateSerial(Year(dteTemp), 1, 1)), _
                        DateOfEaster(Year(dteTemp)) - 2, _
                        DateOfEaster(Year(dteTemp)) + 1, _
                        GetBankHoliday(DateSerial(Year(dteTemp), 5, 1)), _
                        GetBankHoliday(DateSerial(Year(dteTemp), 5, 25)), _
                        GetBankHoliday(DateSerial(Year(dteTemp), 8, 25)), _
                        CorrectDate(DateSerial(Year(dteTemp), 12, 25)), _
                        CorrectDate(DateSerial(Year(dteTemp), 12, 26))
                    Case Else
                        intDays = intDays - 1
                End Select
        End Select
        dteTemp = dteTemp + 1
    Loop
    AddWorkingDays = dteTemp - 1
End Function


Any ideas??
 
Try changing CorrectDate(DateSerial(Year(dteTemp), 1, 1))
to CorrectDate(DateSerial(Year(dteTemp), 1, 1), vbNewYear)
and the same for vbChristmas
and vbBoxingday

Also this is not waterproof (yet) mile, What is xmass is sunday?!

Also, for less experienced programmers, Mile is using a little higher programming skills...
Code: 
            If Weekday(DateSerial(Year(dteTemp), 12, 25)) = 7 Or _
                Weekday(DateSerial(Year(dteTemp), 12, 25)) Then
Note the lack of = 1 on the OR part... 1 is the same as True, so in essance the statement is the same.

Greetz
 
Namliam,

Thanks for the amendment...it's works great :-)

Also this is not waterproof (yet) mile, What is xmass is sunday?!
Click to expand...

I tested this theory and it still apears to work. I called AddWorkingDays("23/12/05", "4") because in the year 2005 Christmas Day is on a Sunday, which means we will be off work on Monday (26th) and Tuesday (27th). So the 4th working day will be 30th December, which is the correct answer I get from Mile's function.
 
If you say so...., just doesnt feel/look right to me somehow....

Guess its the quick look. :eek:

Regards
 
madhouse said:
I tested this theory and it still apears to work. I called AddWorkingDays("23/12/05", "4") because in the year 2005 Christmas Day is on a Sunday, which means we will be off work on Monday (26th) and Tuesday (27th). So the 4th working day will be 30th December, which is the correct answer I get from Mile's function.
Click to expand...

AddWorkingDays("23/12/05", "4")

should be

AddWorkingDays(#23/12/05#, 4)

as the parameters are a date and an integer respectively and not strings

I've fixed the complete code:

Code: 
Option Compare Database
Option Explicit

Public Enum Dates
    vbNewYear = 1
    vbChristmas = 2
    vbBoxingDay = 3
End Enum

Public Function AddWorkingDays(ByVal dteStartDate As Date, _
    ByVal intDays As Integer) As Date
    Dim dteTemp As Date
    dteTemp = dteStartDate
    Do While intDays <> 0
        Select Case Weekday(dteTemp)
            Case Is = 1, 7
            Case Else
                Select Case dteTemp
                    Case Is = CorrectDate(DateSerial(Year(dteTemp), 1, 1), vbNewYear), _
                        DateOfEaster(Year(dteTemp)) - 2, _
                        DateOfEaster(Year(dteTemp)) + 1, _
                        GetBankHoliday(DateSerial(Year(dteTemp), 5, 1)), _
                        GetBankHoliday(DateSerial(Year(dteTemp), 5, 25)), _
                        GetBankHoliday(DateSerial(Year(dteTemp), 8, 25)), _
                        CorrectDate(DateSerial(Year(dteTemp), 12, 25), vbChristmas), _
                        CorrectDate(DateSerial(Year(dteTemp), 12, 26), vbBoxingDay)
                    Case Else
                        intDays = intDays - 1
                End Select
        End Select
        dteTemp = dteTemp + 1
    Loop
    AddWorkingDays = dteTemp - 1
End Function

Public Function CorrectDate(dteTemp As Date, intHoliday As Dates) As Date

    Select Case intHoliday
        Case vbNewYear
            If Weekday(DateSerial(Year(dteTemp), 1, 1)) = 7 Then
                CorrectDate = DateSerial(Year(dteTemp), 1, 3)
            ElseIf Weekday(DateSerial(Year(dteTemp), 1, 1)) = 1 Then
                CorrectDate = DateSerial(Year(dteTemp), 1, 2)
            Else
                CorrectDate = DateSerial(Year(dteTemp), 1, 1)
            End If
        Case vbChristmas
            If Weekday(DateSerial(Year(dteTemp), 12, 25)) = 7 Or _
                Weekday(DateSerial(Year(dteTemp), 12, 25)) = 1 Then
                CorrectDate = DateSerial(Year(dteTemp), 12, 27)
            Else
                CorrectDate = DateSerial(Year(dteTemp), 12, 25)
            End If
        Case vbBoxingDay
            If Weekday(DateSerial(Year(dteTemp), 12, 26)) = 7 Or _
                Weekday(DateSerial(Year(dteTemp), 12, 26)) = 1 Then
                CorrectDate = DateSerial(Year(dteTemp), 12, 28)
            Else
                CorrectDate = DateSerial(Year(dteTemp), 12, 25)
            End If
    End Select

End Function


Public Function DateOfEaster(ByVal intYear As Integer) As Date
    Dim intDominical As Integer, intEpact As Integer, intQuote As Integer
    intDominical = 225 - (11 * (intYear Mod 19))
    If intDominical > 50 Then
        While intDominical > 50
            intDominical = intDominical - 30
        Wend
    End If
    If intDominical > 48 Then intDominical = intDominical - 1
    intEpact = (intYear + Int(intYear / 4) + intDominical + 1) Mod 7
    intQuote = intDominical + 7 - intEpact
    If intQuote > 31 Then
        DateOfEaster = DateSerial(intYear, 4, intQuote - 31)
    Else
        DateOfEaster = DateSerial(intYear, 3, intQuote)
    End If
End Function

Public Function GetBankHoliday(ByRef dteBankHoliday As Date) As Date
    Dim intCounter As Integer
    For intCounter = 0 To 6
        If Weekday(dteBankHoliday + intCounter) = 2 Then
            dteBankHoliday = dteBankHoliday + intCounter
            Exit For
        End If
    Next intCounter
    GetBankHoliday = dteBankHoliday
End Function
 
Mile-O-Phile,

Thanks for the amendments to your code.

With regards to what else you put in your message....

AddWorkingDays("23/12/05", "4")

should be

AddWorkingDays(#23/12/05#, 4)
Click to expand...

When I tried AddWorkingDays(#23/12/05#, 4) and move onto the next line of code it automatically changes to AddWorkingDays(#12/5/2023#, 4).

And If I try AddWorkingDays(#23/12/2005#, 4) and move onto the next line of code it automatically changes to AddWorkingDays(#12/23/2005#, 4).

What is going on??

Also, you say that I shouldn't use AddWorkingsDays("23/12/05", "4") but this somehow works??
 
That's what I tried....

And If I try AddWorkingDays(#23/12/2005#, 4) and move onto the next line of code it automatically changes to AddWorkingDays(#12/23/2005#, 4).
Click to expand...


Also, I'm not sure what code changes you made in your last amendments but I seem to be getting incorrect dates returned now. Taking the date 23/12/05 and days 4 as an example - AddWorkingDays("23/12/05", "4") - I get the date 29/12/05 returned when it should be 30/12/05. Because the 23/12/05 is a Friday so that's the first working day. The 24th is a Saturday, the 25th is a Sunday (Christmas Day) and 26th is a Monday (Boxing Day). But because Christmas falls on a Sunday we get an extra day off work which will be Tuesday 27th. Therefore the 2nd working day will be Wednesday 28th, the 3rd working Thursday 29th and the 4th working day will be Friday 30th. Confused? Funnily enough the original amendments you made for overcoming my Christmas, Boxing and New Year issue returns the correct date (30/12/05)!!
 
sorry if this is a stupid question, but how do I get the current working day number? ie starting from the first weekday and skipping weekends/holidays etc?

Is there a nice simple way of getting this?
 
Well that works...is there a better way though?
Code: 
Public Function WorkingDay(dDate As Date) As Integer
Dim I As Integer

For I = 1 To Day(dDate)
    If Weekday(I & Format(dDate, "/mm/yyyy")) > 1 And Weekday(I & Format(dDate, "/mm/yyyy")) < 7 Then
        WorkingDay = WorkingDay + 1
    End If
Next I
End Function
 
Look at my holiday functions and determine whether their dates fall within your date range. Subtract them from the total if they do.
 
Working Day Functions

I created the below 3 functions to get the working days between 2 dates. Do they help? You can add more holidays to the IsBankHoliday function which may be helpful expecially if your office is closed on certain days.

1. Checks if a date is a bank holiday

Public Function IsBankHoliday(ByVal theDate As Date) As Boolean
Dim hols As New Collection
Dim d As Variant

Set hols = Nothing

hols.Add #1/1/2008#
hols.Add #3/21/2008#
hols.Add #3/24/2008#
hols.Add #5/5/2008#
hols.Add #5/26/2008#
hols.Add #8/25/2008#
hols.Add #12/25/2008#
hols.Add #1/1/2009#
hols.Add #3/17/2009#
hols.Add #4/10/2009#
hols.Add #4/13/2009#
hols.Add #5/4/2009#
hols.Add #5/25/2009#
hols.Add #8/31/2009#
hols.Add #12/25/2009#
hols.Add #12/26/2009#

For Each d In hols
If d = theDate Then
IsBankHoliday = True
Exit Function
End If
Next d

Set hols = Nothing

End Function

2. Checks if a date is a work day (i.e. not a bank holiday or weekend)

Public Function IsWorkDay(ByVal theDate) As Boolean
If IsBankHoliday(theDate) Then
IsWorkDay = False
Exit Function
ElseIf (Weekday(theDate) = 1) Or (Weekday(theDate) = 7) Then
IsWorkDay = False
Exit Function
Else
IsWorkDay = True
End If

End Function

3. Returns the working days difference between 2 dates

Public Function WorkDaysDiff(ByVal StartDate As Date, ByVal EndDate As Date) As Long
Dim i As Date

WorkDaysDiff = 0

For i = StartDate + 1 To EndDate
If IsWorkDay(i) Then WorkDaysDiff = WorkDaysDiff + 1
Next i

End Function
 
Just found this thread and Mile-O's function, which is brilliant but has a tiny error. In the CorrectDate function, the vbBoxingDay case, the last line should end with a 26 not a 25 - I think!!

ie Case vbBoxingDay
If Weekday(DateSerial(Year(dteTemp), 12, 26)) = 7 Or _
Weekday(DateSerial(Year(dteTemp), 12, 26)) = 1 Then
CorrectDate = DateSerial(Year(dteTemp), 12, 28)
Else
CorrectDate = DateSerial(Year(dteTemp), 12, 26)
End If
 
You must log in or register to reply here.

Similar threads

T
Solved Show next working day
Replies
7
Views
943
taball0829
T
mike60smart
Calculated Total Days Vacation taken
Replies
7
Views
1,633
theDBguy
theDBguy
Moote Tiira
Number of days between two dates excluding weekends and holidays
Replies
3
Views
1,724
Pat Hartman
P
P
Solved Access Upgrade to 365 (2016) getting compile errors and a notice to update a "Function"
Replies
3
Views
2,262
theDBguy
theDBguy
J
Add Working Days, excluding We & hols. Function is mixing dd/mm
Replies
16
Views
1,984
Minty
Minty

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom