'--- clsHolidays

Option Explicit

' Hebrew_* Functions by Kees Couprie from
'  http://www.geocities.com/couprie/calmath/index.html

'The following properties are exposed:
' Count() As Long
' HolidayName(holiday As holidays) As String
' HolidayInYear(holiday As holidays, InYear As Date) As Date
' IsHoliday(DateQuery As Date) As Boolean
' HolidayNameOfDate(DateQuery As Date) As String

Public Enum Holidays
    NewYearsDay
    MartinLutherKingDay
    GroundhogDay
    ValentinesDay
    PresidentsDay
    SaintPatricksDay
    TaxDay
    Easter
    MothersDay
    MemorialDay
    FlagDay
    FathersDay
    IndependenceDay
    LaborDay
    ColumbusDay
    Halloween
    ElectionDay
    VeteransDay
    ThanksgivingDay
    ChristmasEve
    Christmas
    NewYearsEve
    RoshHashanah
    YomKippur
    Sukkot
    SheminiAtzeret
    SimchatTorah
    Chanukkah
    TuBShevat
    Purim
    PesachPassover
    LagBOmer
    Shavuot
    TishaBAv
    
    HolidayCount
End Enum

Private Const Hebrew_c_Gregorian = 1
Private Const Hebrew_c_Julian = 1

Public Property Get Count() As Long
    
    Count = HolidayCount
    
End Property

Public Property Get HolidayName(holiday As Holidays) As String
    
    Select Case holiday
        Case NewYearsDay
            HolidayName = "New Year's Day"
        Case MartinLutherKingDay
            HolidayName = "Martin Luther King Day"
        Case PresidentsDay
            HolidayName = "President's Day"
        Case Easter
            HolidayName = "Easter"
        Case MemorialDay
            HolidayName = "Memorial Day"
        Case IndependenceDay
            HolidayName = "Independence Day"
        Case LaborDay
            HolidayName = "Labor Day"
        Case ColumbusDay
            HolidayName = "Columbus Day"
        Case VeteransDay
            HolidayName = "Veterans' Day"
        Case ThanksgivingDay
            HolidayName = "Thanksgiving Day"
        Case Christmas
            HolidayName = "Christmas"
        Case NewYearsEve
            HolidayName = "New Years Eve"
        Case Halloween
            HolidayName = "Halloween"
        Case GroundhogDay
            HolidayName = "Groundhog Day"
        Case ValentinesDay
            HolidayName = "Valentine's Day"
        Case SaintPatricksDay
            HolidayName = "Saint Patrick's Day"
        Case TaxDay
            HolidayName = "Tax Day"
        Case MothersDay
            HolidayName = "Mother's Day"
        Case FlagDay
            HolidayName = "Flag Day"
        Case FathersDay
            HolidayName = "Father's Day"
        Case ElectionDay
            HolidayName = "Election Day"
        Case ChristmasEve
            HolidayName = "Christmas Eve"
        Case RoshHashanah
            HolidayName = "Rosh Hashanah"
        Case YomKippur
            HolidayName = "Yom Kippur"
        Case Sukkot
            HolidayName = "Sukkot"
        Case SheminiAtzeret
            HolidayName = "Shemini Atzeret"
        Case SimchatTorah
            HolidayName = "Simchat Torah"
        Case Chanukkah
            HolidayName = "Chanukkah"
        Case TuBShevat
            HolidayName = "Tu B'Shevat"
        Case Purim
            HolidayName = "Purim"
        Case PesachPassover
            HolidayName = "Pesach (Passover)"
        Case LagBOmer
            HolidayName = "Lag B'Omer"
        Case Shavuot
            HolidayName = "Shavu'ot"
        Case TishaBAv
            HolidayName = "Tisha B'Av"
        Case Else
            Debug.Assert False
            HolidayName = "Error."
    End Select
    
End Property

Public Property Get HolidayInYear(holiday As Holidays, _
    InYear As Date) As Date
    
    Select Case holiday
        Case NewYearsDay
            HolidayInYear = DateSerial(DatePart("yyyy", InYear), 1, 1)
        Case MartinLutherKingDay
            HolidayInYear = DayOfWeek(InYear, 1, 3, vbMonday)
        Case PresidentsDay
            HolidayInYear = DayOfWeek(InYear, 2, 3, vbMonday)
        Case Easter
            HolidayInYear = CalcEaster(InYear)
        Case MemorialDay
            HolidayInYear = LastDayInMonth(InYear, 5, vbMonday)
        Case IndependenceDay
            HolidayInYear = DateSerial(DatePart("yyyy", InYear), 7, 4)
        Case LaborDay
            HolidayInYear = DayOfWeek(InYear, 9, 1, vbMonday)
        Case ColumbusDay
            HolidayInYear = DayOfWeek(InYear, 10, 2, vbMonday)
        Case VeteransDay
            HolidayInYear = DateSerial(DatePart("yyyy", InYear), 11, 11)
        Case ThanksgivingDay
            HolidayInYear = DayOfWeek(InYear, 11, 4, vbThursday)
        Case Christmas
            HolidayInYear = DateSerial(DatePart("yyyy", InYear), 12, 25)
        Case NewYearsEve
            HolidayInYear = DateSerial(DatePart("yyyy", InYear), 12, 31)
        Case Halloween
            HolidayInYear = DateSerial(DatePart("yyyy", InYear), 10, 31)
        Case GroundhogDay
            HolidayInYear = DateSerial(DatePart("yyyy", InYear), 2, 2)
        Case ValentinesDay
            HolidayInYear = DateSerial(DatePart("yyyy", InYear), 2, 14)
        Case SaintPatricksDay
            HolidayInYear = DateSerial(DatePart("yyyy", InYear), 3, 17)
        Case TaxDay
            HolidayInYear = CalcTaxDay(InYear)
        Case MothersDay
            HolidayInYear = DayOfWeek(InYear, 5, 2, vbSunday)
        Case FlagDay
            HolidayInYear = DateSerial(DatePart("yyyy", InYear), 6, 14)
        Case FathersDay
            HolidayInYear = DayOfWeek(InYear, 6, 3, vbSunday)
        Case ElectionDay
            HolidayInYear = DayOfWeek(InYear, 11, 1, vbTuesday)
        Case ChristmasEve
            HolidayInYear = DateSerial(DatePart("yyyy", InYear), 12, 24)
        Case RoshHashanah
            HolidayInYear = Hebrew_InYear(InYear, 1, 1)
        Case YomKippur
            HolidayInYear = Hebrew_InYear(InYear, 1, 10)
        Case Sukkot
            HolidayInYear = Hebrew_InYear(InYear, 1, 15)
        Case SheminiAtzeret
            HolidayInYear = Hebrew_InYear(InYear, 1, 22)
        Case SimchatTorah
            HolidayInYear = Hebrew_InYear(InYear, 1, 23)
        Case Chanukkah
            HolidayInYear = Hebrew_InYear(InYear, 3, 25)
        Case TuBShevat
            HolidayInYear = Hebrew_InYear(InYear, 5, 15)
        Case Purim
            HolidayInYear = Hebrew_InYear(InYear, 6, 14)
        Case PesachPassover
            HolidayInYear = Hebrew_InYear(InYear, 7, 15)
        Case LagBOmer
            HolidayInYear = Hebrew_InYear(InYear, 8, 18)
        Case Shavuot
            HolidayInYear = Hebrew_InYear(InYear, 9, 6)
        Case TishaBAv
            HolidayInYear = Hebrew_InYear(InYear, 11, 9)
        Case Else
            Debug.Assert False
    End Select
    
End Property

Private Function CalcTaxDay(InYear As Date) As Date

    CalcTaxDay = DateSerial(DatePart("yyyy", InYear), 4, 15)
    Do While DatePart("w", CalcTaxDay) = vbSunday Or _
       DatePart("w", CalcTaxDay) = vbSaturday
        CalcTaxDay = DateAdd("d", 1, CalcTaxDay)
    Loop

End Function

Private Function LastDayInMonth(dateYear As Date, nMonth As Long, _
        nDayOfWeek As VbDayOfWeek) As Date
    
    Dim dateValid As Date
    LastDayInMonth = DateSerial(DatePart("yyyy", dateYear), nMonth, 1)
    
    Do Until DatePart("m", LastDayInMonth) <> nMonth
        If DatePart("w", LastDayInMonth) = nDayOfWeek Then
            dateValid = LastDayInMonth
        End If
        
        LastDayInMonth = DateAdd("d", 1, LastDayInMonth)
    Loop
    
    LastDayInMonth = dateValid
    
End Function

Private Function DayOfWeek(dateYear As Date, nMonth As Long, nWeeks As _
        Long, nDayOfWeek As VbDayOfWeek) As Date
    
    DayOfWeek = DateSerial(DatePart("yyyy", dateYear), nMonth, 1)
    
    If DatePart("w", DayOfWeek) > nDayOfWeek Then
        DayOfWeek = DateAdd("d", 7 - (DatePart("w", DayOfWeek) - _
                  nDayOfWeek), DayOfWeek)
    ElseIf DatePart("w", DayOfWeek) < nDayOfWeek Then
        DayOfWeek = DateAdd("d", (nDayOfWeek - DatePart("w", DayOfWeek)), _
                  DayOfWeek)
    End If
    
    DayOfWeek = DateAdd("d", ((nWeeks - 1) * 7), DayOfWeek)
    
End Function

Private Function CalcEaster(InYear As Date) As Date
    
    Dim nGolden As Long
    Dim nTillPaschal As Long
    Dim nDayPaschal As Long
    Dim nCentury As Long
    Dim nEpact As Long
    Dim nSundayPaschal As Long
    
    Dim nMonth As Long
    Dim nDay As Long
    Dim nYear As Long
    
    nYear = DatePart("yyyy", InYear)
    nGolden = nYear Mod 19
    nCentury = nYear \ 100
    nEpact = (nCentury - nCentury \ 4 - (8 * nCentury + 13) \ 25 + 19 * _
           nGolden + 15) Mod 30
    nTillPaschal = nEpact - (nEpact \ 28) * (1 - (nEpact \ 28) * (29 \ _
                 (nEpact + 1)) * ((21 - nGolden) \ 11))
    nDayPaschal = (nYear + nYear \ 4 + nTillPaschal + 2 - nCentury + _
                nCentury \ 4) Mod 7
    nSundayPaschal = nTillPaschal - nDayPaschal
    nMonth = 3 + (nSundayPaschal + 40) \ 44
    nDay = nSundayPaschal + 28 - 31 * (nMonth \ 4)
    
    CalcEaster = DateSerial(nYear, nMonth, nDay)
    
End Function

Public Property Get IsHoliday(DateQuery As Date) As Boolean
    
    Dim i As Long
    
    IsHoliday = False
    
    For i = 0 To HolidayCount - 1
        If Int(DateQuery) = Int(HolidayInYear(i, DateQuery)) Then
            IsHoliday = True
            Exit For
        End If
    Next
    
End Property

Public Property Get HolidayNameOfDate(DateQuery As Date) As String
    
    Dim i As Long
    
    HolidayNameOfDate = "None"
    
    For i = 0 To HolidayCount - 1
        If Int(DateQuery) = Int(HolidayInYear(i, DateQuery)) Then
            HolidayNameOfDate = HolidayName(i)
            Exit For
        End If
    Next
    
End Property

Private Function Hebrew_JulianToDate(ByVal iJulian As Long) As Date

    Hebrew_JulianToDate = CDate(iJulian - 2415019)

End Function

Private Sub Hebrew_JulianToHebrew(ByVal jdn As Long, _
               ByRef iyear As Integer, _
               ByRef iMonth As Integer, _
               ByRef iDay As Integer, _
               Optional ByVal monthcoding As Integer)
    Dim InputJDN As Long
    Dim tishri1 As Long
    Dim LeftOverDays As Long
    If jdn <= 347997 Then
        iyear = 0
        iMonth = 0
        iDay = 0
    Else
        InputJDN = jdn - 347997
        iyear = (InputJDN \ 365) + 1
        tishri1 = Hebrew_ElapsedCalendarDays(iyear)
        While (tishri1 > InputJDN)
            iyear = iyear - 1
            tishri1 = Hebrew_ElapsedCalendarDays(iyear)
        Wend
        iMonth = 1
        LeftOverDays = InputJDN - tishri1
        While (LeftOverDays >= Hebrew_LastDayOfMonth(iyear, iMonth))
            LeftOverDays = LeftOverDays - _
                Hebrew_LastDayOfMonth(iyear, iMonth)
            iMonth = iMonth + 1
        Wend
        If Sgn(monthcoding) = -1 Then
            If iMonth > 6 Then
                If Hebrew_LeapYear(iyear) Then
                    iMonth = iMonth - 14
                Else
                    iMonth = iMonth - 13
                End If
            End If
        End If
        iDay = LeftOverDays + 1
    End If
End Sub

Private Sub Hebrew_GregorianToHebrew(ByRef iyear As Integer, _
                 ByRef iMonth As Integer, _
                 ByRef iDay As Integer)
    Call Hebrew_JulianToHebrew(Hebrew_JulianToGregorian(iyear, _
                              iMonth, _
                              iDay), _
                    iyear, iMonth, iDay)
End Sub

Private Function Hebrew_MonthName(ByVal iyear, _
                                  ByVal iMonth) As String
        
    If ((iMonth > 6) And (Not (Hebrew_LeapYear(iyear)))) Then
       iMonth = iMonth + 1
    End If
    Select Case iMonth
    Case 1
        Hebrew_MonthName = "Tishri"     ' or "Tishrey"
    Case 2
        Hebrew_MonthName = "Heshvan"
    Case 3
        Hebrew_MonthName = "Kislev"
    Case 4
        Hebrew_MonthName = "Teveth"     ' or "Tevet"
    Case 5
        Hebrew_MonthName = "Shevat"
    Case 6
        If (Not (Hebrew_LeapYear(iyear))) Then
            Hebrew_MonthName = "Adar"
        Else
            Hebrew_MonthName = "Adar I"
        End If
    Case 7
        Hebrew_MonthName = "Adar II"
    Case 8
        Hebrew_MonthName = "Nisan"
    Case 9
        Hebrew_MonthName = "Iyyar"
    Case 10
        Hebrew_MonthName = "Sivan"
    Case 11
        Hebrew_MonthName = "Tammuz"
    Case 12
        Hebrew_MonthName = "Av"
    Case 13
        Hebrew_MonthName = "Elul"
    Case Else
        Hebrew_MonthName = ""
    End Select
End Function

Private Function Hebrew_HebrewToJulian(ByVal iyear, _
    ByVal iMonth, ByVal iDay) As Long
    
    Dim jdn As Long
    Dim counter As Integer
    If iMonth < 0 Then
        If Hebrew_LeapYear(iyear) Then
            iMonth = 14 + iMonth
        Else
            iMonth = 13 + iMonth
        End If
    End If
    jdn = Hebrew_ElapsedCalendarDays(iyear)
    For counter = 1 To (iMonth - 1) Step 1
        jdn = jdn + Hebrew_LastDayOfMonth(iyear, counter)
    Next counter
    Hebrew_HebrewToJulian = jdn + (iDay - 1 + 347997)
End Function

Private Function Hebrew_DateInOrAfterCivilYear( _
              ByVal civilYear As Integer, _
              ByVal HebrewMonth As Integer, _
              ByVal HebrewDay As Integer, _
              Optional ByVal calendarType As Integer = _
                Hebrew_c_Gregorian) As Long
    Dim jdnJanuary1 As Long
    Dim jdnHoliday As Long
    Dim hebrewYear As Integer
    Dim dummy1 As Integer
    Dim dummy2 As Integer
    jdnJanuary1 = Hebrew_CivilToJulian(civilYear, 1, 1, calendarType)
    Hebrew_JulianToHebrew jdnJanuary1, hebrewYear, dummy1, dummy2
    jdnHoliday = Hebrew_HebrewToJulian(hebrewYear, _
            HebrewMonth, HebrewDay)
    If jdnHoliday < jdnJanuary1 Then
        ' Oops! Wrong civil Year. Use next hebrewYear's in stead.
        jdnHoliday = Hebrew_HebrewToJulian(hebrewYear + 1, _
                HebrewMonth, HebrewDay)
    End If
    Hebrew_DateInOrAfterCivilYear = jdnHoliday
End Function

Private Function Hebrew_DateInOrBeforeCivilYear( _
              ByVal civilYear As Integer, _
              ByVal HebrewMonth As Integer, _
              ByVal HebrewDay As Integer, _
              Optional ByVal calendarType As Integer = _
                  Hebrew_c_Gregorian) As Long
    Dim jdnDecember31 As Long
    Dim jdnHoliday As Long
    Dim hebrewYear As Integer
    Dim dummy1 As Integer
    Dim dummy2 As Integer
    jdnDecember31 = Hebrew_CivilToJulian(civilYear, _
            12, 31, calendarType)
    Call Hebrew_JulianToHebrew(jdnDecember31, hebrewYear, _
            dummy1, dummy2)
    jdnHoliday = Hebrew_HebrewToJulian(hebrewYear, _
            HebrewMonth, HebrewDay)
    If jdnHoliday > jdnDecember31 Then
        ' Oops! Wrong civil Year. Use last hebrewYear's in stead.
        jdnHoliday = Hebrew_HebrewToJulian(hebrewYear - 1, _
                HebrewMonth, HebrewDay)
    End If
    Hebrew_DateInOrBeforeCivilYear = jdnHoliday
End Function

Private Function Hebrew_ElapsedCalendarDays(ByVal iyear) As Long
    Dim MonthsElapsed As Long
    Dim PartsElapsed As Long
    Dim HoursElapsed As Long
    Dim ConjunctionDay As Long
    Dim ConjunctionParts As Long
    Dim AlternativeDay As Long

    MonthsElapsed = (235 * (((iyear - 1) \ 19))) + _
                    (12 * ((iyear - 1) Mod 19)) + _
                    (7 * ((iyear - 1) Mod 19) + 1) \ 19
    PartsElapsed = 204 + 793 * (MonthsElapsed Mod 1080)
    HoursElapsed = 5 + 12 * MonthsElapsed + _
                   793 * ((MonthsElapsed \ 1080)) + _
                   PartsElapsed \ 1080
    ConjunctionDay = 1 + 29 * MonthsElapsed + HoursElapsed \ 24
    ConjunctionParts = (1080 * (HoursElapsed Mod 24)) + _
                       PartsElapsed Mod 1080
    If ((ConjunctionParts >= 19440) Or _
        (((ConjunctionDay Mod 7) = 2) And _
        (ConjunctionParts >= 9924) And _
        (Not (Hebrew_LeapYear(iyear)))) Or _
       (((ConjunctionDay Mod 7) = 1) And _
        (ConjunctionParts >= 16789) And _
        (Hebrew_LeapYear(iyear - 1)))) _
    Then
        AlternativeDay = ConjunctionDay + 1
    Else
        AlternativeDay = ConjunctionDay
    End If
    If (((AlternativeDay Mod 7) = 0) Or _
        ((AlternativeDay Mod 7) = 3) Or _
        ((AlternativeDay Mod 7) = 5)) _
    Then
        AlternativeDay = AlternativeDay + 1
    End If
    Hebrew_ElapsedCalendarDays = AlternativeDay
End Function


Private Function Hebrew_LastDayOfMonth(ByVal iyear, _
    ByVal iMonth) As Integer
    
    If ((iMonth > 6) And (Not (Hebrew_LeapYear(iyear)))) Then
       iMonth = iMonth + 1
    End If
    Select Case iMonth
    Case 2
        If Hebrew_LongHeshvan(iyear) Then
            Hebrew_LastDayOfMonth = 30
        Else
            Hebrew_LastDayOfMonth = 29
        End If
    Case 3
        If Hebrew_ShortKislev(iyear) Then
            Hebrew_LastDayOfMonth = 29
        Else
            Hebrew_LastDayOfMonth = 30
        End If
    Case 6
        If Hebrew_LeapYear(iyear) Then
            Hebrew_LastDayOfMonth = 30
        Else
            Hebrew_LastDayOfMonth = 29
        End If
    Case 4, 7, 9, 11, 13
        Hebrew_LastDayOfMonth = 29
    Case Else
        Hebrew_LastDayOfMonth = 30
    End Select
End Function

Private Function Hebrew_LeapYear(ByVal iyear) As Boolean
    If ((((7 * iyear) + 1) Mod 19) < 7) Then
       Hebrew_LeapYear = True
    Else
       Hebrew_LeapYear = False
    End If
End Function

Private Function Hebrew_JulianToGregorian(ByVal iyear As Integer, _
                    ByVal iMonth As Integer, _
                    ByVal iDay As Integer) As Long
    Dim lYear As Long
    Dim lMonth As Long
    Dim lDay As Long

    lYear = CLng(iyear)
    lMonth = CLng(iMonth)
    lDay = CLng(iDay)

    Hebrew_JulianToGregorian = 367 * lYear - _
            ((7 * (lYear + 5001 + ((lMonth - 9) \ 7))) \ 4) _
            + ((275 * lMonth) \ 9) + lDay + 1729777

End Function


Private Function Hebrew_CivilToJulian(ByVal iyear As Integer, _
                   ByVal iMonth As Integer, _
                   ByVal iDay As Integer, _
                   Optional ByVal calendarType As Integer _
                       = Hebrew_c_Gregorian) As Long
    Dim lYear As Long
    Dim lMonth As Long
    Dim lDay As Long

    If calendarType = Hebrew_c_Gregorian And ((iyear > 1582) Or _
        ((iyear = 1582) And (iMonth > 10)) Or _
        ((iyear = 1582) And (iMonth = 10) And (iDay > 14))) _
    Then
        lYear = CLng(iyear)
        lMonth = CLng(iMonth)
        lDay = CLng(iDay)
        Hebrew_CivilToJulian = ((1461 * (lYear + 4800 + _
            ((lMonth - 14) \ 12))) \ 4) _
            + ((367 * (lMonth - 2 - 12 * _
            (((lMonth - 14) \ 12)))) \ 12) _
            - ((3 * (((lYear + 4900 + _
            ((lMonth - 14) \ 12)) \ 100))) \ 4) _
            + lDay - 32075
    Else
        Hebrew_CivilToJulian = Hebrew_JulianToGregorian(iyear, _
                iMonth, iDay)
    End If

End Function

Private Function Hebrew_LongHeshvan(ByVal iyear) As Boolean
    Hebrew_LongHeshvan = ((Hebrew_DaysInYear(iyear) Mod 10) = 5)
End Function

Private Function Hebrew_ShortKislev(ByVal iyear) As Boolean
    Hebrew_ShortKislev = ((Hebrew_DaysInYear(iyear) Mod 10) = 3)
End Function

Private Function Hebrew_DaysInYear(ByVal iyear) As Boolean
    Hebrew_DaysInYear = Hebrew_HebrewToJulian(iyear + 1, 1, 1) - _
            Hebrew_HebrewToJulian(iyear, 1, 1)
End Function

Private Function Hebrew_InYear(InYear As Date, ByVal nMonth As Integer, nDay As Integer)

    Dim nMonthOrig As Integer
    Dim nDayOrig As Integer
    Dim nYearOrig As Integer
    Dim nYear As Integer
    
    nMonthOrig = nMonth
    nDayOrig = nDay

    nYear = DatePart("yyyy", InYear)
    nYearOrig = nYear

    Hebrew_InYear = Hebrew_JulianToDate(Hebrew_DateInOrBeforeCivilYear( _
        nYear, nMonth, nDay))
        
    nYear = DatePart("yyyy", Hebrew_InYear)
    nMonth = DatePart("m", Hebrew_InYear)
    nDay = DatePart("d", Hebrew_InYear)
    
    Hebrew_GregorianToHebrew nYear, nMonth, nDay
    
    If Hebrew_LeapYear(nYear) And nMonthOrig >= 7 Then
        Hebrew_InYear = Hebrew_JulianToDate(Hebrew_DateInOrBeforeCivilYear( _
            nYearOrig, nMonthOrig + 1, nDayOrig))
    End If

End Function

'--- End of clsHolidays

    Dim objHolidays As clsHolidays
    Dim i As Long
    Set objHolidays = New clsHolidays
    
    For i = 0 To objHolidays.Count - 1
        Debug.Print objHolidays.HolidayName(i) & " occurs on " & _
            Format(objHolidays.HolidayInYear(i, Now), "mmmm dd, yyyy")
    Next

    If objHolidays.IsHoliday(Now) Then
        Debug.Print "Today is " & objHolidays.HolidayNameOfDate(Now)
    Else
        Debug.Print "Today is not a holiday"
    End If