Often it is necessary to reserve one or more columns to holiday lists, and afterward one has to maintain them and keep them up-to-date or delete the past ones. When this has to be done on more than one spreadsheet can became a pretty unpleasant task.
Here is a fast way to get the official holidays calculated from now ( actually from 1900 ) to 2500, including managing week-ends.
The concept is pretty easy and works for any country even if with some changes :
FORGET the year for the moment. Holiday fall on a specific calendar day ( Jan. 1st, Dec. 25th ) or on a specific day of the week ( President and Martin L King's day, etc. ); and we have to make the whole more tasteful some exception.
Let's take for example:
- Jan. 1: we can see it as 1 ( Jan. ) * 100 + 01 = 101;
- Dec. 25: we can see it as 12 ( Dec. ) * 100 + 25 = 1225.
indipendently from the year we can find out immediately if today is holiday or not; exception if 1225 is saturday or sunday ), etc.
now consider Martin L King or Easter day:
- MLK falls the third Monday in January but alway between Jan. 15 and Jan 22; that means
between 115 and 122;
- Easter ( here you need the year ) falls always on a Sunday between Mar. 3rd ( 322 ) and Apr. 25 ( 425 ) - Why? please refer to Wikipedia.
The only "complex" part is the calculation of Easter ( I use the Gaussian formula ), afterward is just a question of checking if conditions are met.
The code I propose is written for my own pourpose ( I need the Financial Market - not stock exchange - good business days ), for EUR and USD; anyone can easily adapt it to his own need.
Option Explicit
'==========================================
'
' Calculate Gaussian easter day
'
'==========================================
Function rv_Easter(yyyy&)
Dim a&, b&, c&, d&, e&, M&, N&, tmp&
Select Case yyyy
Case 1900 To 2099
M = 24: N = 5
Case 2100 To 2199
M = 24: N = 6
Case 2200 To 2299
M = 25: N = 0
Case 2300 To 2399
M = 26: N = 1
Case 2400 To 2499
M = 24: N = 1
End Select
a = yyyy Mod 19: b = yyyy Mod 4: c = yyyy Mod 7
d = (19 * a + M) Mod 30: e = (2 * b + 4 * c + 6 * d + N) Mod 7: tmp = d + e
If tmp < 10 Then
rv_Easter = DateSerial(yyyy, 3, tmp + 22): Exit Function
Else
tmp = tmp - 9
If tmp = 26 Then
rv_Easter = DateSerial(yyyy, 4, 19): Exit Function
ElseIf tmp = 25 And d = 28 And e = 6 And a > 10 Then
rv_Easter = DateSerial(yyyy, 4, 18): Exit Function
Else
rv_Easter = DateSerial(yyyy, 4, tmp): Exit Function
End If
End If
End Function
'==========================================
'
' check if the day is a good business day
'
'==========================================
Function isGoodBusinessDay(i_date As Date, Optional curr$ = "EUR") As Boolean
Select Case Weekday(i_date)
Case 1, 7
isGoodBusinessDay = False
Case Else
Select Case curr
Case "USD"
isGoodBusinessDay = calendar_USD(i_date)
Case Else
isGoodBusinessDay = calendar_EUR(i_date)
End Select
End Select
End Function
'==============================================
'
' official market holidays in EUR Area
'
'==============================================
Private Function calendar_EUR(i_date As Date) As Boolean
Dim ISO_datum&, ISO_easter_&, easter_ As Date
ISO_datum& = Month(i_date) * 100 + Day(i_date)
Select Case ISO_datum
Case 101, 501, 1225, 1226, 1231
calendar_EUR = False
Exit Function
' if date is between Holy Friday and Easter Monday
Case 322 To 425
easter_ = rv_Easter(Year(i_date))
ISO_easter_ = Month(easter_) * 100 + Day(easter_)
Select Case ISO_datum
Case ISO_easter_ - 2 To ISO_easter_ + 1
calendar_EUR = False
Exit Function
End Select
End Select
calendar_EUR = True
End Function
'==============================================
'
' official market holidays in USD Area
'
'==============================================
Private Function calendar_USD(i_date As Date) As Boolean
Dim ISO_datum&, wk&, ISO_easter_&, easter_ As Date
ISO_datum& = Month(i_date) * 100 + Day(i_date)
wk = Weekday(i_date)
If wk = 2 Then ' if it's Monday
Select Case ISO_datum
Case 102, 705, 1226
calendar_USD = False
Exit Function
Case 115 To 121 ' Martin Luther King day ( it falls on 3rd Monday )
calendar_USD = False
Exit Function
Case 215 To 221 ' President's day ( it falls on 3rd Monday )
calendar_USD = False
Exit Function
Case 525 To 531 ' Memorial day ( it falls on last Monday )
calendar_USD = False
Exit Function
Case 901 To 907 ' Labor day ( it falls on first Monday )
calendar_USD = False
Exit Function
Case 1008 To 1014 ' Columbus day ( it falls on second Monday )
calendar_USD = False
Exit Function
End Select
End If
Select Case ISO_datum
Case 101, 704, 1012, 1225
calendar_USD = False
Exit Function
Case 322 To 425
easter_ = rv_Easter(Year(i_date))
ISO_easter_ = Month(easter_) * 100 + Day(easter_)
Select Case ISO_datum
Case ISO_easter_ - 2 To ISO_easter_
calendar_USD = False
Exit Function
End Select
Case 1122 To 1128 ' Thanksgiving ( 4th Thursday )
If wk = 5 Then calendar_USD = False: Exit Function
Case 1224 ' if it's Friday
If wk = 6 Then calendar_USD = False: Exit Function
End Select
calendar_USD = True
End Function
'==========================================
'
' Calculate Gaussian easter day
'
'==========================================
Function rv_Easter(yyyy&)
Dim a&, b&, c&, d&, e&, M&, N&, tmp&
Select Case yyyy
Case 1900 To 2099
M = 24: N = 5
Case 2100 To 2199
M = 24: N = 6
Case 2200 To 2299
M = 25: N = 0
Case 2300 To 2399
M = 26: N = 1
Case 2400 To 2499
M = 24: N = 1
End Select
a = yyyy Mod 19: b = yyyy Mod 4: c = yyyy Mod 7
d = (19 * a + M) Mod 30: e = (2 * b + 4 * c + 6 * d + N) Mod 7: tmp = d + e
If tmp < 10 Then
rv_Easter = DateSerial(yyyy, 3, tmp + 22): Exit Function
Else
tmp = tmp - 9
If tmp = 26 Then
rv_Easter = DateSerial(yyyy, 4, 19): Exit Function
ElseIf tmp = 25 And d = 28 And e = 6 And a > 10 Then
rv_Easter = DateSerial(yyyy, 4, 18): Exit Function
Else
rv_Easter = DateSerial(yyyy, 4, tmp): Exit Function
End If
End If
End Functionfilippo