I create a 2D array, not knowing how big it will be.

I have an array that comes from reading a sheet. This is like my master sheet of all information (about cats in a rescue).

I’m writing a subroutine to

1. read this sheet into an array (AllVetting) – done in other code and passed to this sub
2. filter the array to find only cats that have not been altered
3. add only the unaltered cats to another array (Unaltered)
4. sort the array (using a subroutine I found on the internet)
5. write array to sheet

I feel this working code is not the best way. I’m not able to properly set the array size.

I know the size of the array AllVetting that is being passed. That array was created using “.CurrentRegion” elsewhere in the code.
When I create the Unaltered array, I don’t yet know how many of the cats listed in AllVetting are not altered and will end up in the Unaltered array.

I made the unaltered array the same size as the AllVetting array to start with. I understand that redim does not work for a 2D array.
Then I have to be a little sloppy with the sort sub call and specify the rowCount as the upper bound for the sort, since the sort subroutine would not work correctly if I included the blank rows.

Is there a better way?

Option Explicit

Public Enum eColumns
   
    Col_AllVetting_IntakeDate = 1
    Col_AllVetting_AnimalID = 2
    Col_AllVetting_AnimalIDx = 3
    Col_AllVetting_Name = 4
    Col_AllVetting_NameNChip = 5
    Col_AllVetting_Description = 6
    Col_AllVetting_Sex = 7
    Col_AllVetting_Age = 8
    Col_AllVetting_DOB = 9
    Col_AllVetting_Microchip = 10
    Col_AllVetting_AlteredYN = 11
    Col_AllVetting_Location = 12
    Col_AllVetting_Status = 13
    Col_AllVetting_Attributes = 14
    Col_AllVetting_Weight = 15
    Col_AllVetting_Price = 16
    Col_AllVetting_FosterName = 17
    Col_AllVetting_FosterPhone = 18
    Col_AllVetting_PhotoYN = 19
    Col_AllVetting_BioYN = 20
    
End Enum

Sub Unaltered(ByRef AllVetting)

    Dim i As Long
    Dim rowCount As Long
    Dim columnCount As Long
    columnCount = 7
    
    Dim Unaltered() As Variant
    ReDim Unaltered(LBound(AllVetting) To UBound(AllVetting), 1 To columnCount)

    For i = LBound(AllVetting, 1) To UBound(AllVetting, 1)
        If AllVetting(i, Col_AllVetting_AlteredYN) = "UnAltered" Then
            rowCount = rowCount + 1
            Unaltered(rowCount, 1) = AllVetting(i, Col_AllVetting_NameNChip)
            Unaltered(rowCount, 2) = AllVetting(i, Col_AllVetting_Location)
            Unaltered(rowCount, 3) = AllVetting(i, Col_AllVetting_FosterPhone)
            Unaltered(rowCount, 4) = AllVetting(i, Col_AllVetting_Sex)
            Unaltered(rowCount, 5) = AllVetting(i, Col_AllVetting_Weight)
            Unaltered(rowCount, 6) = AllVetting(i, Col_AllVetting_DOB)
            Unaltered(rowCount, 7) = AllVetting(i, Col_AllVetting_Status)
        End If
    Next i
    
    Dim sortString As String
    sortString = "2,A,6,D,1,A"
    Call QuickSort2D(Unaltered, sortString, LBound(Unaltered), rowCount)
    
    Worksheets("Unaltered").Range("A1").Resize(rowCount, columnCount).Value = Unaltered
    
    MsgBox "I'm done Unaltered sub"
    
End Sub

I create a 2D array, not knowing how big it will be.

I have an array that comes from reading a sheet. This is like my master sheet of all information (about cats in a rescue).

I’m writing a subroutine to

1. read this sheet into an array (AllVetting) – done in other code and passed to this sub
2. filter the array to find only cats that have not been altered
3. add only the unaltered cats to another array (Unaltered)
4. sort the array (using a subroutine I found on the internet)
5. write array to sheet

I feel this working code is not the best way. I’m not able to properly set the array size.

I know the size of the array AllVetting that is being passed. That array was created using “.CurrentRegion” elsewhere in the code.
When I create the Unaltered array, I don’t yet know how many of the cats listed in AllVetting are not altered and will end up in the Unaltered array.

I made the unaltered array the same size as the AllVetting array to start with. I understand that redim does not work for a 2D array.
Then I have to be a little sloppy with the sort sub call and specify the rowCount as the upper bound for the sort, since the sort subroutine would not work correctly if I included the blank rows.

Is there a better way?

Option Explicit

Public Enum eColumns
   
    Col_AllVetting_IntakeDate = 1
    Col_AllVetting_AnimalID = 2
    Col_AllVetting_AnimalIDx = 3
    Col_AllVetting_Name = 4
    Col_AllVetting_NameNChip = 5
    Col_AllVetting_Description = 6
    Col_AllVetting_Sex = 7
    Col_AllVetting_Age = 8
    Col_AllVetting_DOB = 9
    Col_AllVetting_Microchip = 10
    Col_AllVetting_AlteredYN = 11
    Col_AllVetting_Location = 12
    Col_AllVetting_Status = 13
    Col_AllVetting_Attributes = 14
    Col_AllVetting_Weight = 15
    Col_AllVetting_Price = 16
    Col_AllVetting_FosterName = 17
    Col_AllVetting_FosterPhone = 18
    Col_AllVetting_PhotoYN = 19
    Col_AllVetting_BioYN = 20
    
End Enum

Sub Unaltered(ByRef AllVetting)

    Dim i As Long
    Dim rowCount As Long
    Dim columnCount As Long
    columnCount = 7
    
    Dim Unaltered() As Variant
    ReDim Unaltered(LBound(AllVetting) To UBound(AllVetting), 1 To columnCount)

    For i = LBound(AllVetting, 1) To UBound(AllVetting, 1)
        If AllVetting(i, Col_AllVetting_AlteredYN) = "UnAltered" Then
            rowCount = rowCount + 1
            Unaltered(rowCount, 1) = AllVetting(i, Col_AllVetting_NameNChip)
            Unaltered(rowCount, 2) = AllVetting(i, Col_AllVetting_Location)
            Unaltered(rowCount, 3) = AllVetting(i, Col_AllVetting_FosterPhone)
            Unaltered(rowCount, 4) = AllVetting(i, Col_AllVetting_Sex)
            Unaltered(rowCount, 5) = AllVetting(i, Col_AllVetting_Weight)
            Unaltered(rowCount, 6) = AllVetting(i, Col_AllVetting_DOB)
            Unaltered(rowCount, 7) = AllVetting(i, Col_AllVetting_Status)
        End If
    Next i
    
    Dim sortString As String
    sortString = "2,A,6,D,1,A"
    Call QuickSort2D(Unaltered, sortString, LBound(Unaltered), rowCount)
    
    Worksheets("Unaltered").Range("A1").Resize(rowCount, columnCount).Value = Unaltered
    
    MsgBox "I'm done Unaltered sub"
    
End Sub

• arrays
• excel
• vba

• 2 You can run a loop to count the “unaltered” an then resize the array using that count – Tim Williams Commented Mar 11 at 1:16
• 1 ...ideally create a re-useable function to which you can pass AllVetting, the column index in which to count, and the value to count, and which will return a Long with the matched count. – Tim Williams Commented Mar 11 at 3:27

1 Answer 1

Filter Table Data

• IMO, it is perfectly fine to use the size of the source for the destination in this particular case since you don't need the exact size. I do it all the time. When retrieving all columns or the leftmost columns (consecutively), you don't even need another array. You just write the filtered values to the top of the same array.
• You cannot use this when you need the exact size of the destination, e.g., when you need to populate a combo box.
• You can tackle this in a few ways. The code uses the late-bound version of the CountIf worksheet function on the range which seems to be the simplest.
• If you don't have a range, you could loop through the array and write the row numbers of each matching row to a collection, then loop through the collection using the row numbers to populate the destination array.
• IMO, populating the destination array should be the only operation in the procedure. Using a function is the 'prescribed' way as illustrated in the code.
• Here is how I would do it. I implemented some benchmarking so you would get a feel for how long each operation takes. Sorry for butchering the variables, you can always rename them.

Option Explicit

Public Enum eColumns
    eColIntakeDate = 1
    eColAnimalID = 2
    eColAnimalIDx = 3
    eColName = 4
    eColNameNChip = 5
    eColDescription = 6
    eColSex = 7
    eColAge = 8
    eColDOB = 9
    eColMicrochip = 10
    eColAlteredYN = 11
    eColLocation = 12
    eColStatus = 13
    eColAttributes = 14
    eColWeight = 15
    eColPrice = 16
    eColFosterName = 17
    eColFosterPhone = 18
    eColPhotoYN = 19
    eColBioYN = 20
End Enum

Sub PopulateUnAltered()
    
    ' Define constants.
    Const SRC_SHEET_NAME As String = "Sheet1" ' ???
    Dim SRC_CRITERIA_COLUMN As Long: SRC_CRITERIA_COLUMN = eColAlteredYN
    Const CRITERIA_STRING As String = "UnAltered"
    Dim SRC_COLS() As Variant: SRC_COLS = VBA.Array( _
        eColNameNChip, eColLocation, eColFosterPhone, _
        eColSex, eColWeight, eColDOB, _
        eColStatus)
    Const SORT_STRING As String = "2,A,6,D,1,A"
    Const DST_SHEET_NAME As String = "UnAltered"

    Dim t As Double: t = Timer
    
    ' Reference the workbook.
    Dim wb As Workbook: Set wb = ThisWorkbook
    
    ' Reference the source range.
    Dim sws As Worksheet: Set sws = wb.Sheets(SRC_SHEET_NAME)
    Dim srg As Range: Set srg = sws.Range("A1").CurrentRegion
    
    ' Caclulate the destination size.
    Dim dRowsCount As Long: dRowsCount = Application _
        .CountIf(srg.Columns(SRC_CRITERIA_COLUMN), CRITERIA_STRING)
    Dim dColumnsCount As Long: dColumnsCount = UBound(SRC_COLS) + 1
    
    Debug.Print "Ref/Calc", Timer - t: t = Timer
    
    ' Return the values of the source range in the source array.
    Dim sData() As Variant: sData = srg.Value
    
    Debug.Print "Source", Timer - t: t = Timer
    
    ' Return the filtered values in the destination array.
    Dim dData() As Variant: dData = GetFilteredData(dRowsCount, dColumnsCount, _
        sData, SRC_COLS, SRC_CRITERIA_COLUMN, CRITERIA_STRING)
    Erase sData ' usually irrelevant
    
    Debug.Print "Destination", Timer - t: t = Timer
    
    ' Sort the destination array.
    QuickSort2D dData, SORT_STRING, 1, dRowsCount

    Debug.Print "Sort", Timer - t: t = Timer
    
    ' Copy the values from the destination array to the destination sheet.
    With wb.Sheets(DST_SHEET_NAME).Range("A1")
        .CurrentRegion.Clear
        .Resize(dRowsCount, dColumnsCount).Value = dData
    End With
    
    Debug.Print "Write", Timer - t
    
    ' Inform.
    MsgBox "Sheet """ & DST_SHEET_NAME & """ populated.", vbInformation
    
End Sub

Function GetFilteredData( _
    ByVal dRowsCount As Long, _
    ByVal dColumnsCount As Long, _
    sData() As Variant, _
    sCols() As Variant, _
    ByVal sCriteriaColumn As Long, _
    ByVal CriteriaString As String) _
As Variant

    Dim dData() As Variant: ReDim dData(1 To dRowsCount, 1 To dColumnsCount)

    Dim sRow As Long, dRow As Long, dCol As Long

    For sRow = 1 To UBound(sData, 1)
        If CStr(sData(sRow, sCriteriaColumn)) = CriteriaString Then
            dRow = dRow + 1
            For dCol = 1 To dColumnsCount
                dData(dRow, dCol) = sData(sRow, sCols(dCol - 1))
            Next dCol
        End If
    Next sRow
    
    GetFilteredData = dData
    
End Function