Loop in elements of Array dynamically based on logic using VBA

Question

I am writing a piece of code to pick the current and nextquarter values using Arrays concept in VBA. However i am facing runtime error 13 when running the below code.

Sub PlaceTheQuarter()
Dim arr, Q1, Q2, Q3, Q4

arr = Array(1, "Q1", 2, "Q2", 3, "Q3", 4, "Q4")
Q1 = Array("Jan", "Feb", "Mar")
Q2 = Array("Apr", "May", "Jun")
Q3 = Array("Jul", "Aug", "Sep")
Q4 = Array("Oct", "Nov", "Dec")

'MsgBox (Application.Match(Application.RoundUp(Month(Date) / 3, 0)))
MsgBox (arr(Application.Match(Application.RoundUp(Month(Date) / 3, 0), arr, 0)))

'ENABLE THIS PART TO TEST Q4 ITERATION
Dim idate As Date
idate = "31-DEC-2020"
a = arr(Application.Match(Application.RoundUp(Month(idate) / 3, 0), arr, 0))

'a = arr(Application.Match(Application.RoundUp(Month(Date) / 3, 0), arr, 0))
i = Mid(a, 2, 1)

Dim next_q As Integer

If i = 4 Then
 next_q = 1
Else
 next_q = i + 1
End If

MsgBox ("Next Quarter is: Q" & next_q)

MsgBox (MonthName(Month(idate), True))
counter = 0

Dim n_quarter
n_quarter = "Q" & next_q

    For Each ab In Q4
        If MonthName(Month(idate), True) = ab Then
            MsgBox ab
            Dim pos As Integer
            pos = Application.Match(ab, Q4, False)
            MsgBox pos
        Else
        End If
    Next


End Sub

Basically in the Foreach loop if i use the quarter name manually as Q4 it loops in fine.But i would like to pass it dynamically based on values like Q&next_q ..I've assigned a string value and passed that variable here which isn't either working in my case.

Any pointers on this is much appreciated...

My intention is to get the corresponding quarter array looped in as the date progresses in a year.

Answer 1

Please, test the next code. It should act as (I understood) you requested in the last comment:

Sub PlaceTheQuarter()
 Dim arr, arrQ, Q1, Q2, Q3, Q4, ab, a As String, i As Long, k As Long
 Dim next_q As Long, next_month As Long, arrFin, j As Long, actQ As Long
 
 arr = Array(1, "Q1", 2, "Q2", 3, "Q3", 4, "Q4")
 Q1 = Array("Jan", "Feb", "Mar")
 Q2 = Array("Apr", "May", "Jun")
 Q3 = Array("Jul", "Aug", "Sep")
 Q4 = Array("Oct", "Nov", "Dec")
 arrQ = Array(Q1, Q2, Q3, Q4)

 Dim idate As Date: idate = Date '"02.10.2021"

 a = arr(Application.match(Application.RoundUp(Month(idate) / 3, 0), arr, 0))

 Select Case a
    Case "Q1": next_month = Month(idate): actQ = 0
    Case "Q2": next_month = Month(idate) - 3: actQ = 1
    Case "Q3": next_month = Month(idate) - 6: actQ = 2
    Case "Q4": next_month = Month(idate) - 9: actQ = 3
 End Select
 
 ReDim arrFin((3 - next_month) + 2)
 i = Mid(a, 2, 1)

 If i = 4 Then
    next_q = 1
 Else
    next_q = i + 1
 End If
 'fill the final array containing the remained month plus the next quarter months:
 For j = next_month To 2
    arrFin(k) = arrQ(actQ)(j): k = k + 1
 Next j
 For j = 0 To 2
    arrFin(k) = arrQ(next_q - 1)(j): k = k + 1
 Next j
 '______________________________________________________
 'Iterate between the necessary array elements:
 For Each ab In arrFin
    Debug.Print ab
 Next
End Sub