I'm trying to modify NHarker's Easter VBA to handle an array of dates. In my workbook, the user enters a start year and end year and a formula returns an array of the date of Easter for every year within the years the user entered. The formula spills into x number of rows where x is the number of years the user selected. NHarker's original VBA works when you feed it a single year, but I need it to handle an array of years. So, I modified the VBA, and it works when the number of years is 2 or more. However, the worksheet function returns the VALUE error when the start and end years are the same.
'=========================================
Function EASTER_by_NHarker(year As Variant) As Variant
'Based on Claus Tondering algorithm interpretation.
'See https://www.tondering.dk/claus/cal/calendar29.html
'Norman Harker 10-Jul-2004
'
' Modified by Clint E to handle arrays 2023-09-25
Dim G As Integer: Dim C As Integer: Dim H As Integer
Dim i As Integer: Dim J As Integer: Dim L As Integer
Dim EM As Integer: Dim ED As Integer
Dim Adj1904 As Integer
Dim YearsArray As Variant
Dim DatesArray() As Variant
Dim OutputArray() As Variant
Dim x As Long, y As Long
' Fill the array
Select Case Application.WorksheetFunction.Count(year)
Case 0
Exit Function
Case 1
ReDim YearsArray(2, 1)
YearsArray(1, 1) = year
YearsArray(2, 1) = 0
Case Else
YearsArray = year
End Select
ReDim DatesArray(1 To UBound(YearsArray, 1))
For x = 1 To UBound(YearsArray, 1)
If Not IsDate("1/1/" & YearsArray(x, 1)) Then
EASTER_by_NHarker = "Excel Year Limit Error"
Exit Function
End If
G = YearsArray(x, 1) Mod 19
C = YearsArray(x, 1) \ 100
H = (C - C \ 4 - (8 * C + 13) \ 25 + 19 * G + 15) Mod 30
i = H - (H \ 28) * (1 - (29 \ (H + 1)) * ((21 - G) \ 11))
J = (YearsArray(x, 1) + YearsArray(x, 1) \ 4 + i + 2 - C + C \ 4) Mod 7
L = i - J
EM = 3 + (L + 40) \ 44
ED = L + 28 - (31 * (EM \ 4))
If ActiveWorkbook.Date1904 = True Then
Adj1904 = 365 * 4 + 2
End If
DatesArray(x) = CDate(Trim((DateSerial(YearsArray(x, 1), EM, ED) - Adj1904)))
Next
Select Case Application.WorksheetFunction.Count(year)
Case 1
EASTER_by_NHarker = Application.Transpose(Array(DatesArray(1), ""))
Case Else
EASTER_by_NHarker = Application.Transpose(DatesArray)
End Select
End Function
'=========================================
I would like the function to return the date of Easter for that 1 year in this scenario. I've tried various things like hardcoding a 0 for the second element and then dropping it later in the VBA and overriding with an empty item ("") as the second element, but the worksheet function will not return the single element. I've been tinkering with it for days now. Can someone please assist?
I was finally able to get this to work. In case it helps someone out there, here's what I did.
On the worksheet, I was using a SEQUENCE function inside the EASTER_by_NHarker function. So, something like this:
=EASTER_by_NHarker(SEQUENCE(END_YEAR-START_YEAR+1,1,START_YEAR,1))
This worked when the END_YEAR was any year after the START_YEAR, but it didn't work if the END_YEAR and START_YEAR were the same. So, I used an IF formula to handle the scenario where the start and end years are the same. This is the final formula:
=EASTER_by_NHarker(IF(END_YEAR = START_YEAR,START_YEAR,SEQUENCE(END_YEAR-START_YEAR+1,1,START_YEAR,1)))
And, here's the final VBA script I used to make the Easter function work with an array of years.
Function EASTER_by_NHarker(year As Variant) As Variant
'Based on Claus Tondering algorithm interpretation.
'See https://www.tondering.dk/claus/cal/calendar29.html
'Norman Harker 10-Jul-2004
'
' Modified by Clint E to handle arrays 2023-09-25
Dim G As Integer: Dim C As Integer: Dim H As Integer
Dim i As Integer: Dim J As Integer: Dim L As Integer
Dim EM As Integer: Dim ED As Integer
Dim Adj1904 As Integer
Dim YearsArray As Variant
Dim DatesArray() As Variant
Dim OutputArray() As Variant
Dim x As Long, y As Long
' Fill the array. Handle 1-element arrays separately
Select Case Application.WorksheetFunction.Count(year)
Case 0
Exit Function
Case 1
ReDim YearsArray(1, 1)
YearsArray(1, 1) = year
Case Else
YearsArray = year
End Select
ReDim DatesArray(1 To UBound(YearsArray, 1))
For x = 1 To UBound(YearsArray, 1)
If Not IsDate("1/1/" & YearsArray(x, 1)) Then
EASTER_by_NHarker = "Excel Year Limit Error"
Exit Function
End If
G = YearsArray(x, 1) Mod 19
C = YearsArray(x, 1) \ 100
H = (C - C \ 4 - (8 * C + 13) \ 25 + 19 * G + 15) Mod 30
i = H - (H \ 28) * (1 - (29 \ (H + 1)) * ((21 - G) \ 11))
J = (YearsArray(x, 1) + YearsArray(x, 1) \ 4 + i + 2 - C + C \ 4) Mod 7
L = i - J
EM = 3 + (L + 40) \ 44
ED = L + 28 - (31 * (EM \ 4))
If ActiveWorkbook.Date1904 = True Then
Adj1904 = 365 * 4 + 2
End If
DatesArray(x) = CDate(Trim((DateSerial(YearsArray(x, 1), EM, ED) - Adj1904)))
Next
EASTER_by_NHarker = Application.Transpose(DatesArray)
End Function
Here's what it looks like on the worksheet:
