Increment by quarters within VBA

[MSEconstudent]

Hey guys, I was wondering if anyone knows how to increment by quarters within vba. The code I have currently should work with years, where dateV represents say 2016, originally entered into a inputbox and converted into a value. It should go across the rows 2016 2017 2018 2019 2020 2021 2022. I need to do this for quarters. If I had dateV equal to 2016Q2, excel isn't going to recognize this and pop out 2016Q2, 2016Q3, 2016Q4... etc. like I would want it to. Any clever ideas? Thanks as always!

base.Range("B3").Select

For d = 1 To 7
    ActiveCell.FormulaR1C1 = dateV
    ActiveCell.Offset(0, 1).Select
    dateV = dateV + 1
Next

 

[Michael M]

Maybe this...UNTESTED

Sub MM1()
Dim d As Integer, c As Long, r As Long
d = 3
For c = 2016 To 2023
    For r = 1 To 4
        Cells(3, d).Value = c & "Q" & r
        d = d + 1
    Next r
Next c
End Sub

 

[LockeGarmin]

Here are a few examples (admittedly, 2 and 3 are somewhat similar but I thought it might be helpful to show a couple of different styles).

Sub ListQuarters()

Dim y As Long
Dim q As Long

  For y = 2017 To 2020
    For q = 1 To 4
      MsgBox y & "Q" & q
    Next q
  Next y
  
End Sub

Sub ListQuarters2()

Dim thisDate As Date
Dim i As Long

  thisDate = DateValue("Jan 2017")
  
  For i = 1 To 16
    MsgBox Format$(thisDate, "yyyy\Qq")
    thisDate = DateAdd("Q", 1, thisDate)
  Next

End Sub

Sub ListQuarters3()

Dim thisDate As Date
Dim i As Long

  thisDate = DateValue("Jan 2017")
  
  For i = 0 To 15
    MsgBox Format$(DateAdd("Q", i, thisDate), "yyyy\Qq")
  Next

End Sub

 

[MSEconstudent]

While both of these solutions almost work, the issue is that the range of dates is variable. So I can't use either of the below solutions. I always declare the lower date so say 2016Q1 is declared at the start of the macro, when it prompts you, and then the end range should be set 6 quarters in advance. (it could be any date though, 2021Q3...2035Q4 etc.) So the solutions are very close and I was playing around with them. I then tried the latter two solutions using the DateValue solution but I'm not sure how to let excel know how to place the date in the correct format. That "yyyy\Qq" thing seems to be unique to MsgBox?

Sub MM1()
Dim d As Integer, c As Long, r As Long
d = 3
For c = 2016 To 2023
    For r = 1 To 4
        Cells(3, d).Value = c & "Q" & r
        d = d + 1
    Next r
Next c
End Sub

Sub ListQuarters()

Dim y As Long
Dim q As Long

  For y = 2017 To 2020
    For q = 1 To 4
      MsgBox y & "Q" & q
    Next q
  Next y
  
End Sub

 

[Norie]

What user input should there be?

 

[MSEconstudent]

At the start of the macro it will prompt for a start date and end date. This bit of the macro I am fiddling with should just loop through columns, filling in 20162 20163-- so on until the end date. The start and end dates are variable though and change as noted.

date1 = Application.InputBox("Insert year/quarter so 2 historical quarters show", Default:="2016Q2")
date2 = Application.InputBox("Add 6 qtrs to it, i.e 2016Q2->2017Q4", Default:="2017Q4")

 

[Norie]

Do you mean actual start/end dates or start/end year/quarter?

If it's the latter it should be straightforward to extract the start/end year and start/end quarter to use in loops to produce all the required quarters.

Sub FillQuarters()
Dim rng As Range
Dim date1 As String
Dim date2 As String
Dim qtr As Long
Dim yr As Long

    date1 = InputBox("Insert year/quarter so 2 historical quarters show", Default:="2016Q2")
    date2 = InputBox("Add 6 qtrs to it, i.e 2016Q2->2017Q4", Default:="2017Q4")
    
    qtr = Right(date1, 1)
    yr = Left(date1, 4)
    
    Set rng = Range("A1")
    Do
    
        rng.Value = yr & "Q" & qtr
    
        qtr = qtr + 1
        If qtr = 5 Then
            qtr = 1
            yr = yr + 1
        End If
        
        Set rng = rng.Offset(, 1)
        
    Loop Until yr & "Q" & qtr = date2
    
    rng = date2
    
End Sub

 

[MSEconstudent]

This looks promising. For whatever reason I didn't think of this... getting to q = 5 and dropping it back to 1...
I also was unfamiliar with the "Loop until" function. I'll try this one out. Thanks!

If qtr = 5 Then
            qtr = 1
            yr = yr + 1

[Loop Until yr & "Q" & qtr = date2

 

[Norie]

No problem.

What I posted is a bit clunky, I'm sure it can be done more elegantly, but it should get the job done.

 

[MSEconstudent]

Yup I just put it into my macro, works like a charm with some tinkering. I was having trouble stopping the code, but the Do...Until in combination with the q counter reset worked wonders... #Iamdumb This did the trick. Thanks again!