American Holidays - For TessB (1 Viewer)

Mile-O

Mile-O

Back once again...
Local time
Today, 06:49
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:
Mile-O

Mile-O

Back once again...
Local time
Today, 06:49
Joined
Dec 10, 2002
Messages
11,316
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.
 
R

raskew

AWF VIP
Local time
Today, 00:49
Joined
Jun 2, 2001
Messages
2,734
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.
 
Mile-O

Mile-O

Back once again...
Local time
Today, 06:49
Joined
Dec 10, 2002
Messages
11,316
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.)
 
Mile-O

Mile-O

Back once again...
Local time
Today, 06:49
Joined
Dec 10, 2002
Messages
11,316
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:
 
R

raskew

AWF VIP
Local time
Today, 00:49
Joined
Jun 2, 2001
Messages
2,734
Here in the U.S. 'Bible Belt', there's a problem with computing 'Ash Wednesday'. Can you help?
 
Mile-O

Mile-O

Back once again...
Local time
Today, 06:49
Joined
Dec 10, 2002
Messages
11,316
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
 
R

raskew

AWF VIP
Local time
Today, 00:49
Joined
Jun 2, 2001
Messages
2,734
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:
J

jeff_i

Registered User.
Local time
Today, 01:49
Joined
Jan 24, 2003
Messages
50
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

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
299
jdraw
jdraw
V
Trying to have a button on a form open a report with info from a list box
Replies
18
Views
730
moke123
moke123
N
Code does not support certain characters such as full-width symbols or Chinese
Replies
1
Views
330
ebs17
E
G
Code compilation problem
Replies
9
Views
489
George-Bowyer
G
N
Solved Check If Date is a Bank Holiday
Replies
5
Views
832
Number11
N

Users who are viewing this thread

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