# Thread: [VB6/VBA] "modern" Version of IsLeapYear and LastDayOfMonth-Functions

1. ## [VB6/VBA] "modern" Version of IsLeapYear and LastDayOfMonth-Functions

Hi Folks,
was watching this fascinating video this weekend:
"Implementing Fast Calendar Algorithms"

And i caught myself thinking: Huh? I've been doing the "classical" way all that time

So i searched through the forums here, and pretty much every result showed the "classical" way

So i sat down and rewrote their C/C++-Code in VB6/VBA

Code:
```Public Function IsLeapYear(ByVal AYear As Long) As Boolean
If AYear Mod 100 <> 0 Then
IsLeapYear = (AYear Mod 4) = 0
Else
IsLeapYear = (AYear Mod 16) = 0
End If
End Function

'Could also use ... As Integer
Public Function LastDayOfMonth(ByVal AYear As Long, ByVal AMonth As Long) As Long
If AMonth = 2 Then
If IsLeapYear(AYear) Then
LastDayOfMonth = 29
Else
LastDayOfMonth = 28
End If
Else
LastDayOfMonth = 30 Or (9 * AMonth \ 8)
End If
End Function```
Yes, i'm aware, that there is a "Version" for LastDayOfMonth with a lookup-Array, but in VB6/VBA we would have to initialize that Array first (since constant arrays are not supported),
so i refrained from showing it here

Wouldn't mind reviews or Performance-Test-Results

2. ## Re: [VB6/VBA] "modern" Version of IsLeapYear and LastDayOfMonth-Functions

Btw, AYear Mod 16 is a clever way to check AYear is divisible by 400 using faster bitwise And operation. The reason this works is because 400 is the LCM (least common multiple) of 100 and 16.

cheers,
</wqw>

3. ## Re: [VB6/VBA] "modern" Version of IsLeapYear and LastDayOfMonth-Functions

Originally Posted by wqweto
Btw, AYear Mod 16 is a clever way to check AYear is divisible by 400 using faster bitwise And operation. The reason this works is because 400 is the LCM (least common multiple) of 100 and 16.

cheers,
</wqw>
Ahhh.....so that's the reason.
Somehow, that thing escaped me totally

4. ## Re: [VB6/VBA] "modern" Version of IsLeapYear and LastDayOfMonth-Functions

Why not let VB6/VBA and Windows do the work:

Code:
```
Public Function IsLeapYear(ayear As Long) As Boolean
IsLeapYear = CInt(DateSerial(ayear, 12, 31) - DateSerial(ayear, 1, 1)) = 365
End Function
```
I also once had an end-of-month function somewhere. IIRC, it just went to the first of the next month, and then decremented the date by one.

5. ## Re: [VB6/VBA] "modern" Version of IsLeapYear and LastDayOfMonth-Functions

Code:
```
Public Function EndOfMonth(dt As Date) As Date
Dim iYear As Integer, iMonth As Integer
iYear = Year(dt)
iMonth = Month(dt) + 1
If iMonth > 12 Then iMonth = 1: iYear = iYear + 1
EndOfMonth = DateSerial(iYear, iMonth, 1) - 1#
End Function
```

6. ## Re: [VB6/VBA] "modern" Version of IsLeapYear and LastDayOfMonth-Functions

Outstanding optimization to shave off a couple of nanoseconds every hundred years! It's not even that far fetched to assume your VB program would be still happily chugging along by then!

7. ## Re: [VB6/VBA] "modern" Version of IsLeapYear and LastDayOfMonth-Functions

Originally Posted by Elroy
Code:
```
Public Function EndOfMonth(dt As Date) As Date
Dim iYear As Integer, iMonth As Integer
iYear = Year(dt)
iMonth = Month(dt) + 1
If iMonth > 12 Then iMonth = 1: iYear = iYear + 1
EndOfMonth = DateSerial(iYear, iMonth, 1) - 1#
End Function
```
run your functions against mine a few million times?
i can’t really do performance tests, since i only have VBA available, so not compiled code

8. ## Re: [VB6/VBA] "modern" Version of IsLeapYear and LastDayOfMonth-Functions

Originally Posted by Zvoni
run your functions against mine a few million times?
i can’t really do performance tests, since i only have VBA available, so not compiled code
Yeah, I studies your code a bit more. Yours probably is faster. I suspect those DateSerial() calls would not be as swift as some integer math. IDK, I'm to the point though that, if VB6 & Windows will do the work, I'm not going to do it for them again.

9. ## Re: [VB6/VBA] "modern" Version of IsLeapYear and LastDayOfMonth-Functions

Zvoni, thanks for sharing those. I like yours better than mine but just for fun, here is my leap year function:

Code:
```Public Function IsLeapYear(ByVal y As Long) as Boolean
IsLeapYear = (Month(DateSerial(y, 2, 29)) = 2)
End Function```

10. ## Re: [VB6/VBA] "modern" Version of IsLeapYear and LastDayOfMonth-Functions

Code:
```Private Declare Function IsCalendarLeapYear Lib "kernel32" (ByVal calId As Long, ByVal Year As Long, ByVal Era As Long) As Long

Public Function IsLeapYear(lYear As Long) As Boolean
IsLeapYear = IsCalendarLeapYear(1, lYear, 1)
End Function

Debug.Print IsLeapYear(2024), IsLeapYear(1900)```
Output: True False

11. ## Re: [VB6/VBA] "modern" Version of IsLeapYear and LastDayOfMonth-Functions

Right, i took up the gauntlet, and wrote some "testing code" in VBA/64-Bit.
No idea if i got it right
Feel free to test yourself and/or to correct my "testing code"

Note: I've managed to shave off some nanoseconds in my own LastDayOfMonth-Function, therefore there are now two of them (Z1 and Z2)

Note2: I used random Years between 1600 and 2100, and for LDOF random months

Code:
```Private Type LARGE_INTEGER
lowpart As Long
highpart As Long
End Type

Private Declare PtrSafe Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As LARGE_INTEGER) As Long
Private Declare PtrSafe Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As LARGE_INTEGER) As Long

Private Const TWO_32 = 4294967296# ' = 256# * 256# * 256# * 256#
Private Const ITER = 10# * 1000 * 1000  '10M

Private PerfFrequency As LARGE_INTEGER
Private m_CounterStart As LARGE_INTEGER
Private m_CounterEnd As LARGE_INTEGER
Private m_crFrequency As Double

Private Declare PtrSafe Function IsCalendarLeapYear Lib "kernel32" (ByVal calId As Long, ByVal Year As Long, ByVal Era As Long) As Long

Public Function IsLeapYearVGG(lYear As Long) As Boolean
IsLeapYearVGG = IsCalendarLeapYear(1, lYear, 1)
End Function

Private Function LI2Double(LI As LARGE_INTEGER) As Double
Dim Low As Double
Low = LI.lowpart
If Low < 0 Then
Low = Low + TWO_32
End If
LI2Double = LI.highpart * TWO_32 + Low
End Function

Public Function IsLeapYear(ByVal ayear As Long) As Boolean
If ayear Mod 100 <> 0 Then
IsLeapYear = (ayear Mod 4) = 0
Else
IsLeapYear = (ayear Mod 16) = 0
End If
End Function

Public Function IsLeapYearGCU(ByVal y As Long) As Boolean
IsLeapYearGCU = (Month(DateSerial(y, 2, 29)) = 2)
End Function

Public Function LastDayOfMonthZ1(ByVal ayear As Long, ByVal AMonth As Long) As Long
If AMonth = 2 Then
If IsLeapYear(ayear) Then
LastDayOfMonthZ1 = 29
Else
LastDayOfMonthZ1 = 28
End If
Else
LastDayOfMonthZ1 = 30 Or (9 * AMonth \ 8)
End If
End Function

Public Function LastDayOfMonthZ2(ByVal ayear As Long, ByVal AMonth As Long) As Long
If AMonth = 2 Then
LastDayOfMonthZ2 = 28 - IsLeapYear(ayear)
Else
LastDayOfMonthZ2 = 30 Or (9 * AMonth \ 8)
End If
End Function

Public Function IsLeapYearElroy(ayear As Long) As Boolean
IsLeapYearElroy = CInt(DateSerial(ayear, 12, 31) - DateSerial(ayear, 1, 1)) = 365
End Function

Public Function EndOfMonthElroy(dt As Date) As Date
Dim iYear As Integer, iMonth As Integer
iYear = Year(dt)
iMonth = Month(dt) + 1
If iMonth > 12 Then iMonth = 1: iYear = iYear + 1
EndOfMonth = DateSerial(iYear, iMonth, 1) - 1#
End Function

Private Sub StartCounter()
QueryPerformanceFrequency PerfFrequency
m_crFrequency = LI2Double(PerfFrequency)
QueryPerformanceCounter m_CounterStart
End Sub

Private Function EndCounter() As Double
Dim crStart As Double
Dim crStop As Double
QueryPerformanceCounter m_CounterEnd
crStart = LI2Double(m_CounterStart)
crStop = LI2Double(m_CounterEnd)
EndCounter = 1000# * (crStop - crStart) / m_crFrequency
End Function

Sub main()
Dim i As Long
Dim b As Boolean
Dim e As Long
Dim d As Date
StartCounter
For i = 1 To ITER
b = IsLeapYear(Int(1600 + Rnd * (2100 - 1600 + 1)))
Next
Debug.Print "10M IsLeapYearZvoni = " & EndCounter / 1000 & " seconds"
StartCounter
For i = 1 To ITER
b = IsLeapYearElroy(Int(1600 + Rnd * (2100 - 1600 + 1)))
Next
Debug.Print "10M IsLeapYearElroy = " & EndCounter / 1000 & " seconds"
StartCounter
For i = 1 To ITER
b = IsLeapYearVGG(Int(1600 + Rnd * (2100 - 1600 + 1)))
Next
Debug.Print "10M IsLeapYearVGG = " & EndCounter / 1000 & " seconds"
StartCounter
For i = 1 To ITER
b = IsLeapYearGCU(Int(1600 + Rnd * (2100 - 1600 + 1)))
Next
Debug.Print "10M IsLeapYearGCU = " & EndCounter / 1000 & " seconds"
StartCounter
For i = 1 To ITER
e = LastDayOfMonthZ1(Int(1600 + Rnd * (2100 - 1600 + 1)), Int(1 + Rnd(12 - 1 + 1)))
Next
Debug.Print "10M LastDayOfMonthZ1 = " & EndCounter / 1000 & " seconds"
StartCounter
For i = 1 To ITER
e = LastDayOfMonthZ2(Int(1600 + Rnd * (2100 - 1600 + 1)), Int(1 + Rnd(12 - 1 + 1)))
Next
Debug.Print "10M LastDayOfMonthZ2 = " & EndCounter / 1000 & " seconds"
StartCounter
For i = 1 To ITER
d = EndOfMonthElroy(DateSerial(Int(1600 + Rnd * (2100 - 1600 + 1)), Int(1 + Rnd(12 - 1 + 1)), 1))
Next
Debug.Print "10M EndOfMonthElroy = " & EndCounter / 1000 & " seconds"

End Sub```
My Results (german VBA. --> comma being the decimal-separator)
Code:
```10M IsLeapYearZvoni = 1,8752209 seconds
10M IsLeapYearElroy = 2,5373116 seconds
10M IsLeapYearVGG = 29,3423382 seconds
10M IsLeapYearGCU = 3,8385964 seconds
10M LastDayOfMonthZ1 = 2,6507063 seconds
10M LastDayOfMonthZ2 = 2,6735046 seconds
10M EndOfMonthElroy = 7,4476866 seconds```
VGG, so much for "shaving off some nanoseconds"......

12. ## Re: [VB6/VBA] "modern" Version of IsLeapYear and LastDayOfMonth-Functions

Known fact: API calls in a loop a expensive.

cheers,
</wqw>

13. ## Re: [VB6/VBA] "modern" Version of IsLeapYear and LastDayOfMonth-Functions

Originally Posted by wqweto
Known fact: API calls in a loop a expensive.

cheers,
</wqw>
Why is that Vlad? I was surprised to see that testing IsCalendarLeapYear (within a loop) is an order of magnitude slower than the OP's version on my system (VBA7 64-bit).

14. ## Re: [VB6/VBA] "modern" Version of IsLeapYear and LastDayOfMonth-Functions

WOW, I'm surprised to see that my leapyear came in second, especially with two calls to DateSerial().

15. ## Re: [VB6/VBA] "modern" Version of IsLeapYear and LastDayOfMonth-Functions

Originally Posted by Elroy
WOW, I'm surprised to see that my leapyear came in second, especially with two calls to DateSerial().
Yeah, didn’t expect that one.
But your EOM is expensive, probably because of those steps in between (because you pass a date) and probably because you build a date to return.
my code just looks for the day and returns it.
could rewrite it to return a date to better compare

16. ## Re: [VB6/VBA] "modern" Version of IsLeapYear and LastDayOfMonth-Functions

Originally Posted by Zvoni
...your EOM is expensive, probably because of those steps in between (because you pass a date) and probably because you build a date to return...
Yeah, I like working with Date types when dealing with stuff. I've gotten very comfortable with them for my work. I'm not processing 100s of 1000s of them though, so just sticking with the Date type works great for me.

17. ## Re: [VB6/VBA] "modern" Version of IsLeapYear and LastDayOfMonth-Functions

Originally Posted by Elroy
Yeah, I like working with Date types when dealing with stuff. I've gotten very comfortable with them for my work. I'm not processing 100s of 1000s of them though, so just sticking with the Date type works great for me.
I do understand you, but for me, in 99% of cases, it’s all about the algorithm.
If that one’s good, it will always work with a sufficient performance in pretty much any given scenario.

think about it: 10 million executions in under 2 seconds, and that’s not even „compiled“ code

18. ## Re: [VB6/VBA] "modern" Version of IsLeapYear and LastDayOfMonth-Functions

Originally Posted by GCUser99
Why is that Vlad? I was surprised to see that testing IsCalendarLeapYear (within a loop) is an order of magnitude slower than the OP's version on my system (VBA7 64-bit).
A function call should be the same no matter where the function resides. My guess is more to do with what the function does internally. "IsCalendarLeapYear" takes two more parameters in addition to the year. One is a calendar identifier and the other is an "era" (whatever that means) so who knows what the function does internally but it's certainly a lot more than dividing by 4 or 16...

19. ## Re: [VB6/VBA] "modern" Version of IsLeapYear and LastDayOfMonth-Functions

Originally Posted by VanGoghGaming
... *snip*... but it's certainly a lot more than dividing by 4 or 16...
... but the compiler/CPU is NOT dividing.... it's doing a bitwise AND

20. ## Re: [VB6/VBA] "modern" Version of IsLeapYear and LastDayOfMonth-Functions

Originally Posted by Zvoni
... but the compiler/CPU is NOT dividing.... it's doing a bitwise AND
That's actually a good point. Since both 4 and 16 are powers-of-2, maybe you should just directly do the AND. Then there's no doubt about efficiency. Also, I made sure those literals were Long, maybe saving some casting during runtime.

Code:
```Public Function IsLeapYear(ByVal AYear As Long) As Boolean
If AYear Mod 100& <> 0& Then
IsLeapYear = (AYear And 3&) = 0&
Else
IsLeapYear = (AYear And 15&) = 0&
End If
End Function```
Corrected.

21. ## Re: [VB6/VBA] "modern" Version of IsLeapYear and LastDayOfMonth-Functions

Originally Posted by Elroy
That's actually a good point. Since both 4 and 16 are powers-of-2, maybe you should just directly do the AND. Then there's no doubt about efficiency. Also, I made sure those literals were Long, maybe saving some casting during runtime.

Code:
```Public Function IsLeapYear(ByVal AYear As Long) As Boolean
If AYear Mod 100& <> 0& Then
IsLeapYear = (AYear And 7&) = 0&
Else
IsLeapYear = (AYear And 31&) = 0&
End If
End Function```
Huh?

would have thought ".. mod 4=0" translates to ".. And 3"? (3 dec= 0000 0011 bin)

4 = 2 ^ 2
-->
number number mod 4
00000001 00000001
00000010 00000010
00000011 00000011
00000100 00000000
00000101 00000001
00000110 00000010
00000111 00000011
00001000 00000000
00001001 00000001

and "... mod 16=0" translates to "... And 15"? (15 dec = 0000 1111 bin)
16 = 2 ^ 4
number number mod 16
00000001 00000001
00000010 00000010
00000011 00000011
00000100 00000100
00000101 00000101
00000110 00000110
00000111 00000111
00001000 00001000
00001001 00001001
00001010 00001010
00001011 00001011
00001110 00001110
00001111 00001111
00010000 00000000

22. ## Re: [VB6/VBA] "modern" Version of IsLeapYear and LastDayOfMonth-Functions

So you assume the VB6 compiler would be smart enough to translate "mod 4" into "and 3", etc?

23. ## Re: [VB6/VBA] "modern" Version of IsLeapYear and LastDayOfMonth-Functions

Originally Posted by VanGoghGaming
So you assume the VB6 compiler would be smart enough to translate "mod 4" into "and 3", etc?
I‘m assuming nothing, since the last time i fired up VB6 was some 20 years ago

24. ## Re: [VB6/VBA] "modern" Version of IsLeapYear and LastDayOfMonth-Functions

Ahh, you're right about the translating MOD to AND. I grabbed one too many bits, in both cases.

But I do believe an AND is going to execute much faster than a MOD, especially if the compiler isn't smart enough to see that you're MODding a power-of-2, and I doubt it is.

#### Posting Permissions

• You may not post new threads
• You may not post replies
• You may not post attachments
• You may not edit your posts
•