ji********@compumarc.com wrote:

I owe you thanks for giving attention to this code. I think everyone

who uses it will eventually benefit from your adversarial stance.

James A. Fortune

Functions to be checked:

IsEaster

Public Function IsEaster(dtTestDate As Date) As Boolean

Dim M As Integer

Dim d As Integer

Dim y As Integer

Dim DT As Date

Dim S1 As Integer

Dim S2 As Integer

IsEaster = False

If Month(dtTestDate) < 3 Or Month(dtTestDate) > 4 Then Exit Function

If Month(dtTestDate) = 3 And Day(dtTestDate) < 22 Then Exit Function

If Month(dtTestDate) = 4 And Day(dtTestDate) > 26 Then Exit Function

y = Year(dtTestDate)

S1 = y \ 100

S2 = (S1 - 17) \ 25

M = (15 + S1 - S1 \ 4 - (S1 - S2) \ 3) Mod 30

d = (19 * (y Mod 19) + M) Mod 30

Select Case d

Case 29:

Select Case M

Case 0, 3, 6, 8, 11, 14, 17, 19, 22, 25, 27:

d = 28

Case 2, 5, 10, 13, 16, 21, 24, 29:

d = 27

End Select

End Select

DT = DateAdd("d", d, DateSerial(y, 3, 22))

DT = DT + (8 - WeekDay(DT)) Mod 7

If Month(dtTestDate) = Month(DT) And Day(dtTestDate) = Day(DT) Then

IsEaster = True

End Function

Method:

Run IsEaster for all years that have Easter dates listed on page 876 in

Oxford Companion to the Year by Bonnie Blackburn and Leofranc

Holford-Strevens. A date in the far future for Easter will be included

as well. Note that the earliest possible date for Easter using C. F.

Gauss' formula is March 22 and the latest possible date is 29 + 6 - 9 =

April 26, so no possible test dates were excluded. For each year the

possible range of test dates can only return one date as True from the

IsEaster function.

1997 30 March

1998 12 April

1999 4 April

2000 23 April

2001 15 April

2002 31 March

2003 20 April

2004 11 April

2005 27 March

2006 16 April

2007 8 April

2008 23 March

2009 12 April

2010 4 April

2011 24 April

2012 8 April

2013 31 March

2014 20 April

2015 5 April

2016 27 March

2017 16 April

2018 1 April

2019 21 April

2020 12 April

....

7485 19 April

Test Driver Code:

Private Sub cmdBeginTest_Click()

Dim lngI As Long

Dim lngJ As Long

Dim dtTest As Date

For lngI = 1997 To 2020

dtTest = DateSerial(lngI, 3, 22)

For lngJ = 0 To 35 '31 - 22 + 1 = 10 March days + 26 April days - 1

for 3/22

If IsEaster(dtTest) Then MsgBox (dtTest)

dtTest = DateAdd("d", 1, dtTest)

Next lngJ

Next lngI

dtTest = DateSerial(7485, 4, 19)

MsgBox (IsEaster(dtTest))

End Sub

Code returned all the dates listed and returned True for 4/19/7485.

Functions to be verified:

NthXDay

LastXDay

Public Function NthXDay(N As Integer, d As Integer, dtD As Date) As

Integer

NthXDay = (7 - WeekDay(DateSerial(Year(dtD), Month(dtD), 1)) + d) Mod 7

+ 1 + (N - 1) * 7

End Function

Public Function LastXDay(dtD As Date, DayConst As Integer) As Date

LastXDay = DateSerial(Year(dtD), Month(dtD) + 1,

(-WeekDay(DateSerial(Year(dtD), Month(dtD) + 1, 1), 2) + DayConst - 7)

Mod 7)

End Function

Method:

NthXDay: Since incrementing N simply adds seven it is sufficient to

show that NthXDay works when N = 1. I.e., the first XDay of the month.

This number depends only on which day the first of the month falls.

The 1stXDay is 1 + NumberOfDaysToBeAdded where 0 to 6 are allowed

values for NumberOfDaysToBeAdded. NumberOfDaysToBeAdded is

(DayConstRequested - DayConstFor1stDayOfMonth) Mod 7. But the Mod

function sometimes returns negative numbers instead of numbers in the

range {0, 1, ..., 6} so it must be adjusted to (7 - (DayConstRequested

- DayConstFor1stDayOfMonth)) Mod 7, or equivalently, (7 +

DayConstFor1stDayOfMonth - DayConstRequested) Mod 7. So 1stXDay = (7 +

DayConstRequested - DayConstFor1stDayOfMonth) Mod 7 + 1.

Sample Calculation:

NthXDay(1, vbTuesday, #10/1/05#)

(7 - WeekDay(DateSerial(Year(#10/1/05#), Month(#10/1/05#), 1)) +

vbTuesday) Mod 7 + 1 + (1 - 1) * 7

= (7 - WeekDay(DateSerial(2005, 10, 1)) + 3) Mod 7 + 1 + 0 * 7

= (7 - 7 + 3) Mod 7 + 1

= 4

The first Tuesday in October 2004 is the 4th.

LastXDay: This function goes to the end of the month and backs up 0 to

6 days. So its value is DateSerial(Year(dtD), Month(dtD) + 1,

-NumberOfDaysToSubtract). -NumberOfDaysToSubtract = -

(DayConstEndOfMonth - DayConstRequested) Mod 7, but similarly, = - (7 +

DayConstEndOfMonth - DayConstRequested) Mod 7 = (DayConstRequested -

DayConstEndOfMonth - 7) Mod 7. So, LastXDay = DateSerial(Year(dtD),

Month(dtD) + 1, (DayConstRequested - DayConstEndOfMonth - 7) Mod 7).

DayConstEndOfMonth = Weekday(DateSerial(Year(dtD), Month(dtD) + 1, 0)).

So LastXDay = DateSerial(Year(dtD), Month(dtD) + 1, (-

Weekday(DateSerial(Year(dtD), Month(dtD) + 1, 0)) + DayConst - 7) Mod

7)

This result is slightly different that what I have. Sample

calculations:

LastXDay(#5/1/06#, vbMonday)

DateSerial(2006, 6, (- Weekday(DateSerial(2006, 6, 0)) + 2 - 7) Mod 7)

= DateSerial(2006, 6, (-Weekday(#5/31/06#) - 5) Mod 7)

= DateSerial(2006, 6, (-4 - 5) Mod 7)

= DateSerial(2006, 6, -2)

= #5/29/06#

LastXDay(#5/1/07#, vbMonday)

DateSerial(2007, 6, (- Weekday(DateSerial(2007, 6, 0)) + 2 - 7) Mod 7)

= DateSerial(2007, 6, (-Weekday(#5/31/07#) - 5) Mod 7)

= DateSerial(2007, 6, (-5 - 5) Mod 7)

= DateSerial(2007, 6, -3)

= #5/28/07#

Both versions of LastXDay returned the correct last Monday dates in May

for 2006 through 2011 (if the Date/Time Properties Calendar in Windows

is reliable) but this latest one is cleaner so I'll update the code to

use it.

5/29/06

5/28/07

5/26/08

5/25/09

5/31/10

5/30/11

Holiday definitions to be checked:

Columbus

Labor

Martin Luther King

Memorial

Presidents

Thanksgiving

Veterans

Method:

http://uscode.house.gov/download/pls/5C61.txt
Sec. 6103

Columbus Day

Second Monday in October

Labor Day

First Monday in September

Birthday of Martin Luther King

Third Monday in January

Memorial Day

Last Monday in May

Washington's Birthday (Presidents Day)

Third Monday in February

Thanksgiving Day

Fourth Thursday in November

Veterans Day

November 11

In short, I found no errors in any of the functions with the possible

exception of the old LastXDay function someday getting a different

value than the new LastXDay function. My next change will be to get

rid of the GetWeekdayNumber function and use the Weekday function

instead (with appropriate changes to the numbers) since I no longer

require any weekday numbers starting on Monday.

BTW, to find out if a month has five of a particular day:

'-----Begin module code

Public Function DoesMonthHaveFiveXDays(dtD As Date, DayConst As

Integer) As Boolean

DoesMonthHaveFiveXDays = (NthXDay(5, DayConst, dtD) <=

DaysInMonth(dtD))

End Function

Public Function NthXDay(N As Integer, d As Integer, dtD As Date) As

Integer

NthXDay = (7 - WeekDay(DateSerial(Year(dtD), Month(dtD), 1)) + d) Mod 7

+ 1 + (N - 1) * 7

End Function

Public Function DaysInMonth(dtD As Date) As Integer

DaysInMonth = Day(DateSerial(Year(dtD), Month(dtD) + 1, 0))

End Function

'-----End module code

Sample calls:

DoesMonthHaveFiveXDays(#11/1/05#, vbWednesday) returns True

DoesMonthHaveFiveXDays(#11/1/05#, vbThursday) returns False

James A. Fortune