VBA to List Months Between Two Years

angusfire

New Member
Joined
Feb 24, 2012
Messages
34
I am trying to work out a VBA Sub that will list out all the months between 2 given years. For example; year range is A1:B2 and the Sub would list out the values as shown in A3:B__

AB
119402018
2YearMonth
319401
419402
519403
619404
719405
819406
919407
1019408
1119409
12194010
13194011
14194012
1519411
1619412
1719413
1819414
1919415
2019416
2119417
2219418
2319419
24194110
25194111
26194112
2719421
2819422
2919423
3019424
3119425
3219426
3319427
3419428
3519429
36194210
37194211
38194212

<colgroup><col span="2"></colgroup><tbody>
</tbody>

Thanks in advance!!

Angusfire
 

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
How about
Code:
Sub angusfire()
   Dim i As Long, Rw As Long
   Rw = 3
   For i = Range("A1") To Range("B1")
      Range("A" & Rw).Resize(12).Value = i
      Range("B" & Rw) = 1
      Range("B" & Rw).AutoFill Range("B" & Rw).Resize(12), xlFillSeries
      Rw = Rw + 12
   Next i
End Sub
 
Upvote 0
Try this code:
Code:
Sub MyPopulator()

    Dim startyear As Long, endyear As Long
    Dim y As Long, m As Long
    Dim r As Long
    
    On Error GoTo err_check

'   Capture years
    startyear = Range("A1")
    endyear = Range("B1")
    
    On Error GoTo 0
    
'   Make sure that start year is after 1900
    If startyear < 1900 Then
        MsgBox "Start Year in cell A1 must be after 1900", vbOKOnly, "ENTRY ERROR!"
        Exit Sub
    End If

'   Make sure that end year is not before start year
    If endyear < startyear Then
        MsgBox "End Year in cell B1 cannot be before Start Year in cell A1", vbOKOnly, "ENTRY ERROR!"
        Exit Sub
    End If
    
    Application.ScreenUpdating = False
    
'   Set starting row number
    r = 3
    
'   Loop through all years
    For y = startyear To endyear
'       Loop through all months
        For m = 1 To 12
            Cells(r, "A") = y
            Cells(r, "B") = m
            r = r + 1
        Next m
    Next y
        
    Application.ScreenUpdating = True

    Exit Sub
    

err_check:
    If Err.Number = 13 Then
        MsgBox "Entries in cells A1 and B1 must be numbers!", vbOKOnly, "ENTRY ERROR!"
    Else
        MsgBox Err.Number & ": " & Err.Description
    End If
    
End Sub
I got a few validations in there to help ensure they are entering valid values.
 
Last edited:
Upvote 0

Forum statistics

Threads
1,213,546
Messages
6,114,256
Members
448,557
Latest member
richa mishra

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top