UBound Subscript out of Range Error in Excel VBA

Question

When I run this code, it is getting a subscript out of range error in this specific line:

If i = ws_External_Test_Matrix.Cells(ws_External_Test_Matrix.Rows.Count, 1).End(xlUp).Row Then
    arr_Test_Case_Rows(2, UBound(arr_Test_Case_Rows, 2)) = i ' <-- This line
End If

I unfortunately did not write this code, but my understanding is that i is supposed to be the upper bound of the array above. I've tried troubleshooting a bit and it appears that arr_Test_Case_Rows(2, UBound(arr_Test_Case_Rows, 2)) = 0 which would suggest that the Array is unallocated and therefore the error is coming from somewhere above this line. From what I have read it could be from the redim portions but I've tried ReDim arr_Test_Case_Rows(1 To 2, 1 To 1) right before the error line and while it ran, the results did not populate as expected. Anything I can do here to fix this?

Sub Populate_Test_Matrix()
    Dim str_External_Test_Matrix_Name As String
    Dim ws_External_Test_Matrix As Worksheet
    Dim ws_TestMatrix_Tab As Worksheet
    Dim ws_ItemInputs As Worksheet
    Dim ws_ItemOutputs As Worksheet
    Dim rng_Header_Copy_Start As Range
    Dim rng_Header_Copy_End As Range
    Dim rng_Copy_Start As Range
    Dim rng_Copy_End As Range
    Dim rng_Paste_Start As Range
    Dim i As Long
    Dim j As Long
    Dim arr_Test_Case_Rows() As Variant
    Dim boo_Empty_Row_Ind As Boolean
    Dim xlx As XlXmlExportResult
    Dim xmlmp As XmlMap
    Dim str_Replace_String As String
    Dim arr_XML_String_Holder() As Variant
    Dim str_XML_Save_Name As String
    Dim str_Record As String
    Dim str_State As String
    Dim int_Test_Case_Start_Row As Long
    
    Application.ScreenUpdating = False

    str_External_Test_Matrix_Name = Open_Workbook(ThisWorkbook.Sheets("Macro_Menu").Range("Test_Case_Matrix_Path").Value)
    Set ws_External_Test_Matrix = Workbooks(str_External_Test_Matrix_Name).Sheets("MATRIX")
    Set ws_TestMatrix_Tab = ThisWorkbook.Sheets("TESTMatrix")
    Set ws_ItemInputs = ThisWorkbook.Sheets("ITEMINPUTS")
    Set ws_ItemOutputs = ThisWorkbook.Sheets("ITEMOUTPUTS")
    
    
    'Get start and end row numbers of test cases from External Test Matrix, and record into array
    boo_Empty_Row_Ind = False
    'Determine first row (header row) of Test Cases, to determine which row to begin looping from when
    'finding Test Cases
    int_Test_Case_Start_Row = ws_External_Test_Matrix.Range("A:A").Find(what:="Record", LookIn:=xlValues, LookAt:=xlWhole, After:=ws_External_Test_Matrix.Cells(ws_External_Test_Matrix.Rows.Count, 1)).Row
    For i = int_Test_Case_Start_Row To ws_External_Test_Matrix.Cells(ws_External_Test_Matrix.Rows.Count, 1).End(xlUp).Row
        'If 0, then row is empty
        If (Application.CountA(ws_External_Test_Matrix.Cells(i, 1).EntireRow) = 0) And _
           (ws_External_Test_Matrix.Cells(i, 1).EntireRow.Interior.ColorIndex = 1) Then   'If 1, then row is colored black
            If boo_Empty_Row_Ind = False And (Not Not arr_Test_Case_Rows) <> 0 Then 'Array is allocated
                arr_Test_Case_Rows(2, UBound(arr_Test_Case_Rows, 2)) = i - 1
            End If
            boo_Empty_Row_Ind = True
        Else    'Row is NOT empty
            'If we previously hit empty row and current row is now non-empty, we have test case to record
            If boo_Empty_Row_Ind = True Then
                boo_Empty_Row_Ind = False
                
                If (Not Not arr_Test_Case_Rows) = 0 Then    'if 0, then array is unallocated
                    ReDim arr_Test_Case_Rows(1 To 2, 1 To 1)
                Else
                    ReDim Preserve arr_Test_Case_Rows(1 To 2, 1 To UBound(arr_Test_Case_Rows, 2) + 1)
                End If
                'arr_Test_Case_Rows(1, X) = start row of test case
                'arr_Test_Case_Rows(2, X) = end row of test case
                arr_Test_Case_Rows(1, UBound(arr_Test_Case_Rows, 2)) = i
                
            End If
        End If
        
        'If I = last row of loop counter
        If i = ws_External_Test_Matrix.Cells(ws_External_Test_Matrix.Rows.Count, 1).End(xlUp).Row Then
            arr_Test_Case_Rows(2, UBound(arr_Test_Case_Rows, 2)) = i ' <-- This line
        End If
    Next i

The business case context- the broader program that this module is in takes in a sheet of data and reformats it to be uploaded in another program.

The sheet is made up of one header row followed by rows of records of varying size (1 record could be 1 row, all the way up to 7). The blank rows are used to separate when one record ends and another begins.

This particular module is recording where records exist (not blank row) and the line where it breaks is referring to the final non blank row in the sheet.

In this screenshot it is 40 rows, but the actual case is 55.

Answer 1

Here's a slightly different approach using a Collection instead of an array:

Sub Populate_Test_Matrix()
    
    Dim wb As Workbook, extWb As Workbook, wsExtTM As Worksheet, colRecs As Collection
    Dim inRecord As Boolean, firstRecordRow, lastRow As Long
    Dim rw As Range, rec, startRow As Long
    
    'better for Open_Workbook to return a reference to the workbook, instead of its name...
    Set extWb = Open_Workbook(wb.Sheets("Macro_Menu").Range("Test_Case_Matrix_Path").Value)
    Set wsExtTM = extWb.Sheets("MATRIX")
    
    firstRecordRow = Application.Match("Record", wsExtTM.Columns("A"), 0)
    If IsError(firstRecordRow) Then
        MsgBox "'Record' not found in ColA", vbCritical
        Exit Sub
    End If
    
    Set colRecs = New Collection 'using a collection seems simpler
    inRecord = False
    Set rw = wsExtTM.Rows(firstRecordRow)
    lastRow = wsExtTM.Cells(wsExtTM.Rows.Count, 1).End(xlUp).Row
    
    Do While rw.Row <= lastRow
        If Not RowIsEmpty(rw) Then
            If Not inRecord Then
                startRow = rw.Row 'save the start row
                inRecord = True
            End If
        Else
            If inRecord Then 'were we previously in a record?
                colRecs.Add Array(startRow, rw.Row - 1)
                inRecord = False
            End If
        End If
        Set rw = rw.Offset(1, 0) 'next row
    Loop
    colRecs.Add Array(startRow, lastRow) 'close the last record
    
    For Each rec In colRecs
        Debug.Print "Start row:" & rec(0), "End row:" & rec(1)
    Next rec
    
End Sub

'factored out a bit of logic...
Function RowIsEmpty(rw As Range) As Boolean
    'using color not colorindex...
    RowIsEmpty = Application.CountA(rw) = 0 And rw.Interior.Color = vbBlack
End Function