Display all next 20 years leap year vba

[vbvba]

Hi Guys,

I would like to know how to print next 20 leap years in vba program

I have a function to find leap year as below, but how to print the years in excel A column can you help me ?

Public Function isLeapYear()


' returns FALSE if not Leap Year, TRUE if Leap Year
isLeapYear = (Month(DateSerial(Yr, 2, 29)) = 2)




End Function

 

[Scott Huish]

Sub Next20LeapYears()
Dim nowyear As Long, x As Long, y As Long
nowyear = Year(Now)
x = 1
For y = nowyear To nowyear + 100
    If Month(DateSerial(y, 2, 29)) = 2 Then
        Cells(x, 1) = y
        x = x + 1
        If x > 20 Then Exit For
    End If
Next
End Sub

 

[Trebor76]

Probably not as elegant, but here's my attempt:

Option Explicit
Sub Macro2()

    Dim blnIsLeapYear As Boolean
    Dim intMyYear As Integer
    Dim intMyCount As Integer
    
    intMyYear = Year(Now()) 'Start from the current year
    blnIsLeapYear = False
    
    Application.ScreenUpdating = False
    
    'Find the first leap year from now
    Do Until blnIsLeapYear = True
        blnIsLeapYear = Evaluate("IF(OR(MOD(" & intMyYear & ",400)=0,AND(MOD(" & intMyYear & ",4)=0,MOD(" & intMyYear & ",100)<>0)),1,0)")
        If blnIsLeapYear = 0 Then
            intMyYear = intMyYear + 1
        End If
    Loop
    
    'Now we have the start year (i.e. fist leap year) we can return the next 20 leap years
    intMyCount = 1
    Do Until intMyCount = 20
    
        If intMyCount = 1 Then
            Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = intMyYear
        Else
            intMyYear = intMyYear + 4
            Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = intMyYear
        End If
        
        intMyCount = intMyCount + 1
        
    Loop
    
    Application.ScreenUpdating = True
    
    MsgBox "Done", vbInformation

End Sub

HTH

Robert

 

[Rick Rothstein]

Here is my attempt... it is long, but it is a one-liner (I used line continuations to make it fit better), plus it will give as many leap years as you want (simply change the red number to the number of leap years you want to see)...

Sub Next20LeapYears()
  Range("A1").Resize([B][COLOR="#FF0000"]20[/COLOR][/B]) = Application.Transpose(Split(Application.Trim(Join( _
                           Evaluate("TRANSPOSE(IF(ISNUMBER(MONTH(""2/29/""&" & _
                           "ROW(A2015:A9999))),ROW(A2015:a9999),""""))")))))
End Sub

 

[Rick Rothstein]

Here is my attempt... it is long, but it is a one-liner (I used line continuations to make it fit better), plus it will give as many leap years as you want (simply change the red number to the number of leap years you want to see)...

Sub Next20LeapYears()
  Range("A1").Resize([B][COLOR="#FF0000"]20[/COLOR][/B]) = Application.Transpose(Split(Application.Trim(Join( _
                           Evaluate("TRANSPOSE(IF(ISNUMBER(MONTH(""2/29/""&" & _
                           "ROW(A2015:A9999))),ROW(A2015:a9999),""""))")))))
End Sub

Actually, let's generalize it (still a one-liner though)... the following macro will give the next 20 (but you can change the red number to whatever you want) leap years starting with the current year...

Sub TheNextSoManyLeapYears()
  Range("A1").Resize([B][COLOR="#FF0000"]20[/COLOR][/B]) = Application.Transpose(Split(Application.Trim(Join(Evaluate( _
                           "TRANSPOSE(IF(ISNUMBER(MONTH(""2/29/""&ROW(A" & Year(Now) & _
                           ":A9999))),ROW(A" & Year(Now) & ":a9999),""""))")))))
End Sub

 

[shg]

Or, via formula,

={2016;2020;2024;2028;2032;2036;2040;2044;2048;2052;2056;2060;2064;2068;2072;2076;2080;2084;2088;2092}

 

[Rick Rothstein]

Or, via formula,

={2016;2020;2024;2028;2032;2036;2040;2044;2048;2052;2056;2060;2064;2068;2072;2076;2080;2084;2088;2092}

Well... that is kind of "cheating", isn't it? I mean, if you are going to look the number up, it would probably be easier to put the numbers directly in the cells rather than in a semi-colon delimited formula list only to then select the proper number of cells and then CTRL+SHIFT+ENTER that formula into them.

 

[shg]

Speed-wise, faster than 7000 calculations. Many of us of us will not be around for the next 20 leap years.

 

[vbvba]

Sub Next20LeapYears()
Dim nowyear As Long, x As Long, y As Long
nowyear = Year(Now)
x = 1
For y = nowyear To nowyear + 100
    If Month(DateSerial(y, 2, 29)) = 2 Then
        Cells(x, 1) = y
        x = x + 1
        If x > 20 Then Exit For
    End If
Next
End Sub

Thanks heaps Scott. It works

 

[vbvba]

Hi Rick,

You have optimized the code great work
However, as am learning VBA.
Could you please tell me how this line of code works ?

Application.Transpose(Split(Application.Trim(Join(Evaluate( _
"TRANSPOSE(IF(ISNUMBER(MONTH(""2/29/""&ROW(A" & Year(Now) & _
":A9999))),ROW(A" & Year(Now) & ":a9999),""""))")))))