Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations wOOdy-Soft on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

How to determine if date is holiday?

Status
Not open for further replies.

mkal

Programmer
Jun 24, 2003
223
US
Is there a function or script that can determine if a given date falls on a holiday (usa) without creating a lookup table.

Thanks in advance,
mkal
 
You can build an auto-generated holiday look-up table for most of the holidays (once you have a database of each holiday you want to generate and its rules). With the look-up table you can then write your own UDF. Easter and most of the jewish holidays are the difficult ones. I haven't figured out a way to generate those, so I do manual updates for them (and you can pre-enter years in advance). If you're interested in more let me know.
-Karl
 
You could create a function to do the calculating, but I prefer to use a lookup table for efficiency reasons. However, you could create a function to determine all the holidays. It will return a table of holidays. Run the function in a stored proceudre and use it to populate a holiday lookup table. Schedule the stored proceudre to run on Dec 31 every year. Use the lookup table everytime you need to do something with holidays as that is more efficient than calculating the holidays on the fly using a function.

Just remember to update the holiday function if your company changes which holidays they celebrate.

 
Here is a function that I used a few years ago, unfortunantly I can't rememeber where I got or who wrote it! Another drawback ist that it calculates for german Holidays, but you could change it yours.

Code:
Function IstFeiertag( _
    Optional ByVal Datum As Variant _
  ) As Boolean
  IstFeiertag = Len(Feiertag(Datum)) > 0
End Function
Function Holiday()
  DoEvents
  Dim Dba As DAO.Database, Rst As DAO.Recordset
  Set Dba = CurrentDb
  
  
  Dim Jahr As Integer
  Dim Datum As Variant
  

'  Jahr = Year(Now)
  Jahr = 2003

  'Debug.Print "Feiertage im Jahr"; Jahr
  For Datum = DateSerial(Jahr, 1, 1) To DateSerial(Jahr, 12, 31)
  
  Set Rst = Dba.OpenRecordset("SELECT * FROM tbl_Wochentag" _
                  & " WHERE cdate([Datum]) = '" _
                  & Datum & "'")
  
    If IstFeiertag(Datum) Then 'Debug.Print Datum, Feiertag(Datum)
        Rst.Edit
        Rst("ft") = -1
        Rst.Update
    End If
  Next Datum
End Function

Public Function Feiertag( _
    Optional ByVal Datum As Variant _
  ) As String
  Dim TagMonat As Integer
  
  If IsMissing(Datum) Then Datum = Now
  TagMonat = Day(Datum) * 100 + Month(Datum)
  Select Case TagMonat 'im Format DDMM
   Case 101: Feiertag = "Neujahr"
   'Case 601: Feiertag = "Dreikönigstag *"
    Case 105: Feiertag = "Tag der Arbeit"
    'Case 1508: Feiertag = "Mariä Himmelfahrt *"
    Case 310: Feiertag = "Tag der deutschen Einheit"
    Case 111: Feiertag = "Allerheiligen"
    'Case 2412: Feiertag = "Heiligabend *"
    Case 2512: Feiertag = "1. Weihnachtstag"
    Case 2612: Feiertag = "2. Weihnachtstag"
    'Case 3112: Feiertag = "Silvester *"
    Case Else: Feiertag = FeiertagV(Datum)
  End Select
End Function


Public Function FeiertagV( _
    Optional ByVal Datum As Variant _
  ) As String
  Dim Tage As Integer
  
  If IsMissing(Datum) Then Datum = Now
  Tage = DateDiff("d", Ostersonntag(Year(Datum)), Datum)
  Select Case Tage 'relativ zu Ostersonntag
  Case -2: FeiertagV = "Karfreitag"
  Case 0:  FeiertagV = "Ostersonntag"
  Case 1:  FeiertagV = "Ostermontag"
  Case 39: FeiertagV = "Christi Himmelfahrt"
  Case 49: FeiertagV = "Pfingsonntag"
  Case 50: FeiertagV = "Pfingstmontag"
  Case 60: FeiertagV = "Fronleichnam"
  End Select
End Function

Public Function Ostersonntag( _
    Optional ByVal Jahr As Integer _
  ) As Variant
  Dim d1 As Integer
  Dim d2 As Integer
  Dim d3 As Integer
  Dim d4 As Integer
  
  'Formel nach C.F.Gauss gilt 1583 - 8202:
  If Jahr = 0 Then Jahr = Year(Now)
  If Jahr < 1583 Or Jahr > 8202 Then _
      Err.Raise 5 'Invalid argument'
  
  'Berechnung der Korrekturwerte:
  d1 = (8 * (Jahr \ 100) + 13) \ 25 - 2
  d2 = (Jahr \ 100) - (Jahr \ 400) - 2
  d1 = (15 + d2 - d1) Mod 30
  d3 = 2 * (Jahr Mod 4) + 4 * (Jahr Mod 7)
  d4 = (d1 + 19 * (Jahr Mod 19)) Mod 30
  If d4 = 29 Then
    d4 = 28
  ElseIf d4 = 28 Then
    If (Jahr Mod 19) > 10 Then d4 = 27
  End If
  d3 = (6 + d2 + d3 + 6 * d4) Mod 7
  
  'Berechnung des Datums (ausgehend vom 22.3.):
  Ostersonntag = DateSerial(Jahr, 3, 22 + d4 + d3)
End Function
The "tbl_Wochentag" is an imported table out of excel that lists all dates and weekdays for the next 20 years.

HTH
 
The above reply isn't very timely, but so that others know, there is now an FAQ on the subject:
Holiday Calendar Calculator faq183-5075
-Karl

[red] Cursors, Triggers and User Definded Functions are part of the Axis of Evil![/red]
[green]Life's uncertain...eat dessert first...www.deerfieldbakery.com[/green]
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top