Reply to Message
Working days
The functions here will work up to 9999. Any extra bank holidays can be added in a similar manner to the 5th June Diamond jubilee one.
The EasterSunday function was not written by me but comes from the ERLANDSEN DATA CONSULTING site and is, I think, the sweetest bit of code I've seen.
Function EasterSunday(InputYear As Integer) As Long
' Returns the date for Easter Sunday, does not depend on Excel
Dim d As Integer
d = (((255 - 11 * (InputYear Mod 19)) - 21) Mod 30) + 21
EasterSunday = DateSerial(InputYear, 3, 1) + d + (d > 48) + 6 - _
((InputYear + InputYear \ 4 + d + (d > 48) + 1) Mod 7)
End Function
Function WrkDays(StartDate As Date, EndDate As Date) As Integer
Dim d&
Dim Cnt&
Dim DC As Date
Dim WD&
Dim A&
Dim M&
Dim NY&
Dim ES As Date
Dim EM&
Dim Yno
Dim DN&
Dim CD As Date
Dim BD As Date
'Dim ES As Date
'It is assumed that there will only be 1 easter during the spell
'Check for a weekend
d = EndDate - StartDate
DC = StartDate
A = 0
NY = 0
'Stop
For Cnt = 1 To d Step 1
WD = Weekday(DC, vbSunday)
DN = DatePart("d", DC)
Select Case WD
Case 1, 7
'This is a weekend
A = A
Case Else
'This is a weekday
'Check for a bank holiday
'Get the month from the date DC
M = Month(DC)
Select Case M
Case 1
'January
'NYD is first weekday
'Check the day number
'is the start date in the first week
'Find the day of January 1
CD = DateValue("1/1/" & Year(DC))
'What day of the week is it?
WD = Weekday(CD)
Select Case WD
Case 1
'Sunday
'nyd Tomorrow
If DC = CD + 1 Then
A = A
Else
A = A + 1
End If
Case 2, 3, 4, 5, 6
'Monday, Tuesday, Wednesday, Thursday or Friday
'NYD today
A = A
Case 7
'Saturday
'NYD Monday
If DC = CD + 2 Then
A = A
Else
A = A + 1
End If
End Select
Case 2
'February
'No current holidays
A = A + 1
Case 3
'March
'Earliest dates for Easter
'Get the date of easter
ES = EasterSunday(Year(DC))
EM = Month(ES)
If EM = M Then
'Easter is this month
If DC ES - 2 Then
A = A + 1
ElseIf DC ES + 1 Then
A = A + 1
End If
Else
A = A + 1
End If
Case 4
'April
'Late dates for Easter
'Get the date of easter
'Stop
ES = EasterSunday(Year(DC))
EM = Month(ES)
If EM = M Then
'Easter is this month
If DC = ES - 2 Then
A = A
GoTo ED
ElseIf DC = ES + 1 Then
A = A
GoTo ED
Else
A = A + 1
End If
Else
A = A + 1
End If
ED:
Case 5
'May
DN = DatePart("d", DC)
Select Case DN
Case 1 To 7
'First monday in May
Select Case WD
Case 2
'This is a Monday
Case Else
'The other days are working days
A = A + 1
End Select
Case 25 To 31
'Last Monday in May
Select Case WD
Case 2
'This is a Monday
Case Else
'The other days are working days
A = A + 1
End Select
Case Else
A = A + 1
End Select
Case 6
'June
'No Current Holidays
'Diamond Jubilee 2012 only 5th June
'is the year 2012?
'Specific code for extra bank holidays
'Select the year
Yno = Year(DC)
'Check if this year applies to the bank holiday
If Yno = 2012 Then
'If the year is relevant then do the following
DN = DatePart("d", DC)
'Get the day number
If DN 5 Then
'Check if the day number matches the day of the bank holiday
A = A + 1
'If it does not match add 1 to the working days total
End If
Else
A = A + 1
End If
Case 7
'July
'No Current holidays
A = A + 1
Case 8
'August
'Last Monday in August
DN = DatePart("d", DC)
Select Case DN
Case 25 To 31
'Last Monday in May
Select Case WD
Case 2
'This is a Monday
Case Else
'The other days are working days
A = A + 1
End Select
Case Else
A = A + 1
End Select
Case 9
'September
'No Current Holidays
A = A + 1
Case 10
'October
'No current Holidays
A = A + 1
Case 11
'November
'No Current Holidays
A = A + 1
Case 12
'December
'25th Christmas
'26th Boxing day
'If Christmas or Boxing day is a weekend then the next weekday is used.
Yno = Year(DC)
CD = DateValue("25/12/" & Year(DC))
BD = DateValue("26/12/" & Year(DC))
WD = Weekday(CD, vbSunday)
Select Case WD
Case 1, 7
'Christmas day is a Saturday or Sunday
'The following Monday and Tuesday are bank holidays
If WD = 1 Then
If DC = CD + 1 Then
A = A
ElseIf DC = CD + 2 Then
A = A
Else
A = A + 1
End If
ElseIf WD = 7 Then
If DC = CD + 2 Then
A = A
ElseIf DC = CD + 2 Then
A = A
Else
A = A + 1
End If
End If
Case 2, 3, 4
'Christmas day is a Monday, Tuesday, Wednesday or Thursday
'Today and Tomorrow are bank holidays
If DC = CD Then
A = A
ElseIf DC = CD + 1 Then
A = A
Else
A = A + 1
End If
Case 6
'Christmas day is a Friday
'Friday and the following Monday are bank holidays
If DC = CD Then
A = A
ElseIf DC = CD + 3 Then
A = A
Else
A = A + 1
End If
Case Else
A = A + 1
End Select
End Select
'A = A + 1
End Select
DC = DC + 1
Next Cnt
WrkDays = A
End Function
The EasterSunday function was not written by me but comes from the ERLANDSEN DATA CONSULTING site and is, I think, the sweetest bit of code I've seen.
Function EasterSunday(InputYear As Integer) As Long
' Returns the date for Easter Sunday, does not depend on Excel
Dim d As Integer
d = (((255 - 11 * (InputYear Mod 19)) - 21) Mod 30) + 21
EasterSunday = DateSerial(InputYear, 3, 1) + d + (d > 48) + 6 - _
((InputYear + InputYear \ 4 + d + (d > 48) + 1) Mod 7)
End Function
Function WrkDays(StartDate As Date, EndDate As Date) As Integer
Dim d&
Dim Cnt&
Dim DC As Date
Dim WD&
Dim A&
Dim M&
Dim NY&
Dim ES As Date
Dim EM&
Dim Yno
Dim DN&
Dim CD As Date
Dim BD As Date
'Dim ES As Date
'It is assumed that there will only be 1 easter during the spell
'Check for a weekend
d = EndDate - StartDate
DC = StartDate
A = 0
NY = 0
'Stop
For Cnt = 1 To d Step 1
WD = Weekday(DC, vbSunday)
DN = DatePart("d", DC)
Select Case WD
Case 1, 7
'This is a weekend
A = A
Case Else
'This is a weekday
'Check for a bank holiday
'Get the month from the date DC
M = Month(DC)
Select Case M
Case 1
'January
'NYD is first weekday
'Check the day number
'is the start date in the first week
'Find the day of January 1
CD = DateValue("1/1/" & Year(DC))
'What day of the week is it?
WD = Weekday(CD)
Select Case WD
Case 1
'Sunday
'nyd Tomorrow
If DC = CD + 1 Then
A = A
Else
A = A + 1
End If
Case 2, 3, 4, 5, 6
'Monday, Tuesday, Wednesday, Thursday or Friday
'NYD today
A = A
Case 7
'Saturday
'NYD Monday
If DC = CD + 2 Then
A = A
Else
A = A + 1
End If
End Select
Case 2
'February
'No current holidays
A = A + 1
Case 3
'March
'Earliest dates for Easter
'Get the date of easter
ES = EasterSunday(Year(DC))
EM = Month(ES)
If EM = M Then
'Easter is this month
If DC ES - 2 Then
A = A + 1
ElseIf DC ES + 1 Then
A = A + 1
End If
Else
A = A + 1
End If
Case 4
'April
'Late dates for Easter
'Get the date of easter
'Stop
ES = EasterSunday(Year(DC))
EM = Month(ES)
If EM = M Then
'Easter is this month
If DC = ES - 2 Then
A = A
GoTo ED
ElseIf DC = ES + 1 Then
A = A
GoTo ED
Else
A = A + 1
End If
Else
A = A + 1
End If
ED:
Case 5
'May
DN = DatePart("d", DC)
Select Case DN
Case 1 To 7
'First monday in May
Select Case WD
Case 2
'This is a Monday
Case Else
'The other days are working days
A = A + 1
End Select
Case 25 To 31
'Last Monday in May
Select Case WD
Case 2
'This is a Monday
Case Else
'The other days are working days
A = A + 1
End Select
Case Else
A = A + 1
End Select
Case 6
'June
'No Current Holidays
'Diamond Jubilee 2012 only 5th June
'is the year 2012?
'Specific code for extra bank holidays
'Select the year
Yno = Year(DC)
'Check if this year applies to the bank holiday
If Yno = 2012 Then
'If the year is relevant then do the following
DN = DatePart("d", DC)
'Get the day number
If DN 5 Then
'Check if the day number matches the day of the bank holiday
A = A + 1
'If it does not match add 1 to the working days total
End If
Else
A = A + 1
End If
Case 7
'July
'No Current holidays
A = A + 1
Case 8
'August
'Last Monday in August
DN = DatePart("d", DC)
Select Case DN
Case 25 To 31
'Last Monday in May
Select Case WD
Case 2
'This is a Monday
Case Else
'The other days are working days
A = A + 1
End Select
Case Else
A = A + 1
End Select
Case 9
'September
'No Current Holidays
A = A + 1
Case 10
'October
'No current Holidays
A = A + 1
Case 11
'November
'No Current Holidays
A = A + 1
Case 12
'December
'25th Christmas
'26th Boxing day
'If Christmas or Boxing day is a weekend then the next weekday is used.
Yno = Year(DC)
CD = DateValue("25/12/" & Year(DC))
BD = DateValue("26/12/" & Year(DC))
WD = Weekday(CD, vbSunday)
Select Case WD
Case 1, 7
'Christmas day is a Saturday or Sunday
'The following Monday and Tuesday are bank holidays
If WD = 1 Then
If DC = CD + 1 Then
A = A
ElseIf DC = CD + 2 Then
A = A
Else
A = A + 1
End If
ElseIf WD = 7 Then
If DC = CD + 2 Then
A = A
ElseIf DC = CD + 2 Then
A = A
Else
A = A + 1
End If
End If
Case 2, 3, 4
'Christmas day is a Monday, Tuesday, Wednesday or Thursday
'Today and Tomorrow are bank holidays
If DC = CD Then
A = A
ElseIf DC = CD + 1 Then
A = A
Else
A = A + 1
End If
Case 6
'Christmas day is a Friday
'Friday and the following Monday are bank holidays
If DC = CD Then
A = A
ElseIf DC = CD + 3 Then
A = A
Else
A = A + 1
End If
Case Else
A = A + 1
End Select
End Select
'A = A + 1
End Select
DC = DC + 1
Next Cnt
WrkDays = A
End Function
Posted by ken@...
10th Jan 2012
