Subscript out of range error due to redim array

Question

The basic mission of this code is to use a list as the source of data for my a listbox control...with a catch. I only want the rows that have black cell in column 14 of the list.

To accomplish this, I attempted to assign an the cells to an array and assign the array using the list property.

I feel like I have read every refence document available and adhered to all the references, but I continually get this 'subscript out of range' error when 'redimming' the array in a preserved fashion after a for...next loop.

Before I use a temporary list to store my data construct, I really want to nail this dynamic array...but if it is too much work, then I'll have to settle for the easier option. Also, this is a learning process. Also, please forgive my sloppy indentations and everything else.

Option Explicit

'This code initializes the frmEntry form and sets the list box control
' to list the active escorts (escort records that have blank values
' in the 'End' field of the visitor log (VLog tabl on Visitor Log worksheet).

Private Sub UserForm_Initialize()

Dim wksVisitorLog As Worksheet
Dim wbkVMS As Workbook
Dim Last_Row As Long
Dim objVisitorEscortList As ListObject
Dim objListRow As ListRows
Dim objListCols As ListColumns
Dim listCounter As Single
Dim rowCounter As Single
Dim listArray()
Dim ri As Single
Dim ci As Single
Dim c As Single


Set wbkVMS = ThisWorkbook
Set wksVisitorLog = wbkVMS.Worksheets("Visitor Log")
Set objVisitorEscortList = wksVisitorLog.ListObjects("tblVisitorEscortLog")
Set objListRow = objVisitorEscortList.ListRows
Set objListCols = objVisitorEscortList.ListColumns
rowCounter = 0
ri = 0
ci = 0
c = 0

'Prepares the list box.
With frmEntry
  
  .listboxActiveEscorts.Clear
  .listboxActiveEscorts.ColumnCount = "15"
  .listboxActiveEscorts.ColumnHeads = True
  .listboxActiveEscorts.ColumnWidths = "80,100,100,0,0,100,100,0,0,50,0,0,80,80,80"
    
End With

ReDim listArray(ri, 14)

'This section adds Escort/Visitor records to list box
For listCounter = 1 To objListRow.Count 'Increments based on the total rows on "Visitor Log"
  
    'Selects the row if the "End" field (14th column) is blank
    If objVisitorEscortList.Range.Cells(listCounter + 1, 14) = "" Then
    
      'Increments the row for the listbox array, and will only increment when the if condition is true

        For ci = 0 To 14 'Starts inner loop index for the listbox control column
      
             c = c + 1 'Increments the list range column of the "Visitor Log"
        
        'This portion of the code assigns the two dimensional array index
        listArray(ri, ci) = objVisitorEscortList.Range.Cells(listCounter + 1, c).Value
 
        Next ci
    
    End If
ReDim Preserve listArray(UBound(listArray, 1) + 1)

Next listCounter

'Assigns the entire array to list
listboxActiveEscorts.List = listArray

MsgBox "There are " & frmEntry.listboxActiveEscorts.ListCount & " total active escorts at this time", vbOKOnly

listCounter = 0

End Sub

Alfredo Holguin · Accepted Answer

welcome, the issue is that you declare a 2 dimensional array: ReDim listArray(ri, 14)

this would be similar to: ReDim listArray(0 to ri, 0 to 14)

meaning that there are 0 to ri rows and 0 to 14 columns in each row.

then you attempt to redim preserve it by only listing the row section: ReDim Preserve listArray(UBound(listArray, 1) + 1)

in order to redim a 2 dimensional array you must transpose the array before adding any extra rows. If you want to add another column, you do not have to transpose the array.

you can use the function:

Function varTransposeArray(varInput As Variant) As Variant
' brief, will transpose, flip the row and columns for a 2 dimensional array
' argument, varInput, the array that should be transpose, it can be oany type array, string, integer, varaint, etc, but function will return a variant.
    Dim lRow As Long, lColumn As Long
    Dim vTemporaryArray As Variant

    ' redim vTemporaryArray to the dimensions of varInput
    ' must specify both lbound and uBound for both dimensions otherwise the output might not be correct, for example, it might have a lBound of 0 instead of 1
    ReDim vTemporaryArray(LBound(varInput, 2) To UBound(varInput, 2), LBound(varInput, 1) To UBound(varInput, 1))
    
    ' loop through all values of varInput
    For lRow = LBound(varInput, 2) To UBound(varInput, 2)
        For lColumn = LBound(varInput, 1) To UBound(varInput, 1)
            
            ' transpose, or flip, the row and column of varInput into vTemporaryArray
            If Not VarType(varInput(lColumn, lRow)) = vbObject Then
                vTemporaryArray(lRow, lColumn) = varInput(lColumn, lRow)
            Else
                Set vTemporaryArray(lRow, lColumn) = varInput(lColumn, lRow)
            End If
            
        Next lColumn
    Next lRow

    varTransposeArray = vTemporaryArray

end function

then you can use:

listArray = varTransposeArray(listArray)
                    ReDim Preserve listArray(LBound(listArray, 1) To UBound(listArray, 1), LBound(listArray, 2) To UBound(listArray, 2) + 1)
                    listArray = varTransposeArray(listArray)

If this answers your question, click thumbs up, thanks.

Subscript out of range error due to redim array

Answers (2)

Related Questions