K & K Consulting    K & K Consulting

K&K Home VB Guru Home Search VB Site VB Code VB Tips VB Tutorials VB Questions

K&K Home
Up

 

Check For Good Friday

'***************************************************************************
'* Function Name : bIsGoodFriday                                           *
'* Created By : Thomas A. Cassano                                          *
'* date : 00/00/98                                                         *
'* Purpose : Determines whether the day is Good Friday                     *
'* Arguments : dCompare_date                                               *
'* Returns : Boolean                                                       *
'* Comments : None                                                         *
'***************************************************************************

Function bIsGoodFriday(dCompare_date as date) as Boolean


Dim iCurrent_Year         as Integer
Dim a                     as Integer
Dim b                     as Integer
Dim c                     as Integer
Dim d                     as Integer
Dim e                     as Integer
Dim iDayOfEasterSunday    as Integer
Dim iMonthOfEasterSunday  as Integer

Dim dEasterSunday         as date
Dim dGoodFriday           as date

    iCurrent_Year = Year(dCompare_date)

    a = iCurrent_Year Mod 19
    b = iCurrent_Year Mod 4
    c = iCurrent_Year Mod 7
    d = (19 * a + 24) Mod 30
    e = (2 * b + 4 * c + 6 * d + 5) Mod 7

    iDayOfEasterSunday = 22 + d + e

    iMonthOfEasterSunday = 3

    If iDayOfEasterSunday > 31 then

        iDayOfEasterSunday = d + e - 9

        iMonthOfEasterSunday = 4

    End If

    If iDayOfEasterSunday = 26 And iMonthOfEasterSunday = 4 then

        iDayOfEasterSunday = 19

    End If

    If iDayOfEasterSunday = 25 And iMonthOfEasterSunday = 4 And d = 28 And e = 6 And a > 10 then

        iDayOfEasterSunday = 18

    End If

    dEasterSunday = DateSerial(iCurrent_Year, iMonthOfEasterSunday,     iDayOfEasterSunday)
    dGoodFriday = DateAdd("d", -2, dEasterSunday)

End Function
    
   

Latest Review Just In


Send mail to WebMaster with questions or comments about this web site.
This website is best viewed with a screen resolution of 800*600 or better.
This website is optimized for Microsoft Internet Explorer 6.x
K&K Consulting, Proud to be a Microsoft Business Partner.
Last modified: January 31, 2002