二维数组下标超出 ReDim 范围

Question

I have a 2D array in VBA (Excel 365).

It gives me an error message Subscript out of Range

The code stops at the ReDim line.

ReDim arrs(1 To 1, 1 to 6) As Variant
For idx = 1 To lr
    If staff_group(idx) = "" Then Exit For        
        If InStr(LCase(staff_group(idx)), "al - ") Then
            arrs(UBound(arrs,1), 1) = sg(idx)
            arrs(UBound(arrs,1), 2) = nd(idx)
            arrs(UBound(arrs,1), 3) = intv(idx)
            arrs(UBound(arrs,1), 4) = rq(idx)
            arrs(UBound(arrs,1), 5) = prd(idx) + id(idx)
            arrs(UBound(arrs,1), 6) = IIfw(idx) = "Y", "1", IIfh(idx) = "-1", "OVR", ""))

            ReDim Preserve arrs(1 To UBound(arrs,1) + 1, 1 to 6)
        End If
Next

My working code below:

ReDim arrs(1 To 1) As Variant
    For idx = 1 To lr

        If staff_group(idx) = "" Then Exit For

        If InStr(LCase(staff_group(idx)), "al - ") Then
            ReDim temp(6) As Variant
            temp(0) = sg(idx)
            temp(1) = nd(idx)
            temp(2) = intv(idx)
            temp(3) = rq(idx)
            temp(4) = prd(idx) + id(idx)
            temp(5) = IIf(waive(idx) = "Y", "1", IIf(hold(idx) = "-1", "OVR", ""))
            arrs(UBound(arrs)) = temp
            ReDim Preserve arrs(1 To UBound(arrs) + 1)
        End If
    Next

Answer 1

you may want to use ReDim statement as few times as possible

Dim arrDim As Long ' long value to store arrs actual dimension

ReDim arrs(1 To lr) As Variant ' initial dimming of arrs to its maximum possible size
For idx = 1 To lr

    If staff_group(idx) = "" Then Exit For

    If InStr(LCase(staff_group(idx)), "al - ") Then

        ReDim temp(6) As Variant
        temp(0) = sg(idx)
        temp(1) = nd(idx)
        temp(2) = intv(idx)
        temp(3) = rq(idx)
        temp(4) = prd(idx) + ID(idx)
        temp(5) = IIf(waive(idx) = "Y", "1", IIf(hold(idx) = "-1", "OVR", ""))

        arrDim = arrDim + 1 ' update arrs currently needed size
        arrs(arrDim) = temp ' update arrs item at currently needed size index
    End If

Next
ReDim Preserve arrs(1 To arrDim + 1) ' finally, redim arrs to final size

Please note that ReDim Preserve arrs(1 To arrDim + 1) leads to an empty arrs last item, as per your example.

Shouldn't you need it, then just use ReDim Preserve arrs(1 To arrDim)