American Holidays - For TessB

Mile-O

Mile-O

Back once again...
Local time
Today, 09:21
Joined
Dec 10, 2002
Messages
11,316
As I said, don't know if all the holidays are relevant but:

Code: 
Public Function GetAmericanHoliday(ByVal intYear As Integer, _
    intHoliday As Integer) As Date

    Dim intAdditions(0 To 4) As Integer
    Dim intMonths(0 To 4) As Integer
    Dim intDays As Integer
    Dim dteStart As Date ' create a preliminary starting point
    Dim intWeekday As Date ' create a store for weekday calcualtions

    ' This function deals with five American holidays.
    ' Whichever holiday you wish calculated is received in the
    ' intHoliday parameter. The holidays are:
        ' 0: President's Day (third Monday in February)
        ' 1: Memorial Day (last Monday in May)
        ' 2: Labor Day (first Monday in September)
        ' 3: Columbus Day (second Monday in October)
        ' 4: Thanksgiving Day (fourth Thursday in November)
        
    ' check intHoliday falls within expected numbers
    If intHoliday < 0 Or intHoliday > 4 Then Exit Function
   
    intAdditions(0) = 14
    intAdditions(1) = -7
    intAdditions(2) = 0
    intAdditions(3) = 7
    intAdditions(4) = 21
    intMonths(0) = 2
    intMonths(1) = 6
    intMonths(2) = 9
    intMonths(3) = 10
    intMonths(4) = 11

    intDays = IIf(intHoliday = 4, 5, 2)
    
    dteStart = DateSerial(intYear, intMonths(intHoliday), 1)
    intWeekday = WeekDay(dteStart)

    GetAmericanHoliday = dteStart + IIf(intDays < intWeekday, 7 - intWeekday + intDays, intDays - intWeekday) + intAdditions(intHoliday)

End Function
 
Last edited:
If you have a version of Access greater than 97 then you may wish to make use of the Enum statement by putting this variation on the code in a module.

Basically:

Code: 
Enum ahHoliday
    ahPresidents = 0
    ahMemorial = 1
    ahLabor = 2
    ahColumbus = 3
    ahThanksgiving = 4
End Enum

Public Function GetAmericanHoliday(ByVal intYear As Integer, _
    intHoliday As ahHoliday) As Date

    Dim intAdditions(0 To 4) As Integer
    Dim intMonths(0 To 4) As Integer
    Dim intDays As Integer
    Dim dteStart As Date ' create a preliminary starting point
    Dim intWeekday As Date ' create a store for weekday calcualtions

    ' This function deals with five American holidays.
    ' Whichever holiday you wish calculated is received in the
    ' intHoliday parameter. The holidays are:
        ' 0: President's Day (third Monday in February)
        ' 1: Memorial Day (last Monday in May)
        ' 2: Labor Day (first Monday in September)
        ' 3: Columbus Day (second Monday in October)
        ' 4: Thanksgiving Day (fourth Thursday in November)
        
    ' check intHoliday falls within expected numbers
    If intHoliday < 0 Or intHoliday > 4 Then Exit Function
   
    intAdditions(0) = 14
    intAdditions(1) = -7
    intAdditions(2) = 0
    intAdditions(3) = 7
    intAdditions(4) = 21
    intMonths(0) = 2
    intMonths(1) = 6
    intMonths(2) = 9
    intMonths(3) = 10
    intMonths(4) = 11

    intDays = IIf(intHoliday = 4, 5, 2)
    
    dteStart = DateSerial(intYear, intMonths(intHoliday), 1)
    intWeekday = Weekday(dteStart)

    GetAmericanHoliday = dteStart + IIf(intDays < intWeekday, 7 - intWeekday + intDays, intDays - intWeekday) + intAdditions(intHoliday)

End Function

This time notice that the second parameter is not an Integer but the enumerated type ahHoliday.

When you try to call the function, the second parameter will drop done like other IntelliSense objects, properties, and methods.
 
Listen closely and you can almost hear the music in the background:
"This is dedicated to the one ..."

Gotta ask, is this connected to something?

Spiffy code though -- still trying to decipher the logic that makes it work.
 
raskew said:
Gotta ask, is this connected to something?
Click to expand...

I've done a procedure before regarding counting the number of days between dates excluding weekends and public holidays - mine, of course, were excluding British Holidays so I wrote that procedure for American Holidays (don't know if they should be excluded though, just found out on which day of which month some occur.)
 
raskew said:
Spiffy code though -- still trying to decipher the logic that makes it work.
Click to expand...

I've just been playing about with it further and think I'll be able to make a pretty good class module out of it - a world holiday object model! :confused:
 
Here in the U.S. 'Bible Belt', there's a problem with computing 'Ash Wednesday'. Can you help?
 
Ash Wednesday occurs 46 days before Easter Sunday.


Code: 
Dim dteAshWednesday As Date
dteAshWednesday = DateAdd("d", -46, DateOfEaster([b]yearVariable[/b]))


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
 
Mile-O

Thanks for that. Actually have used a similar function for years but was interested to see what you'd come up with.

Look at this code (for Easter), then compare it with yours. The two look miles apart but amazingly arrive at the same result.

Code: 
Function Easter2(theYear As Variant) As Date
'*******************************************
'Name:      Easter2 (Function)
'Purpose:   Calculates the date Easter falls on
'           in a given year (Gregorian Calendar)
'Source:    [url]http://www.landfield.com/faqs/astronomy/faq/part3/section-11.html[/url]
'Coded by:  raskew
'Inputs:    ? Easter2(2003)
'Output:    4/20/2003
'*******************************************

Dim C, H, g, datehold, datestart, FM

datestart = DateValue("1/1/" & theYear)
g = (Year(datestart) Mod 19) + 1
H = Int(Year(datestart) / 100)
C = -H + Int(H / 4) + Int(8 * (H + 11) / 25)
datehold = DateSerial(Year(datestart), 4, 19)
FM = datehold - ((11 * g + C) Mod 30)
FM = IIf(Month(FM) = 4 And Day(FM) = 19 And g >= 12, FM - 2, FM)
FM = IIf(Month(FM) = 4 And Day(FM) = 19, FM - 1, FM)
Easter2 = FM + 7 - WeekDay(FM) + 1

End Function
Best wishes, Bob
 
Last edited:
Mile-O-Phile

Thanks for all the information, I just wasnt understanding what the purpose was now I understand it was to figure out British bank holidays, I was making more out it.

I will try your suggestions and just work off of holiday table, I may have more questions tommorow if you don't mind

Thanks again
 
You must log in or register to reply here.

Similar threads

Feral
Solved Finding Tenure Time
2
Replies
21
Views
578
Feral
Feral
A
Filter Records
Replies
1
Views
256
June7
June7
K
How can I add this code to the storage location of my file before scanning and then convert it to a PDF file?
2
Replies
25
Views
997
The_Doc_Man
The_Doc_Man
D
Solved How to sort values (the highest first)? If duplicates values found, the sorting is based on the saved table for those values
Replies
13
Views
810
jdraw
jdraw
A
Need VBA Help with Printer Status
Replies
1
Views
482
June7
June7

Users who are viewing this thread

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