Creating 2 dimensional array from larger 2 dimensional array

Question

I can't get around the below problem and any help would be greatly appreciated

I have a 2 dimensional array that looks like the below;

PFAllArr

I want to create a new array (PFArr) from this, but without the rows where deleted = "yes". I could make this new array the same size as the original one, just leaving blank rows where i have removed data, but this array will be used in numerous loops down the code so i want to make it as compact as possible.

With the below code i have tried to get the number of elements where deleted = 0 ( which i want to keep)... using a loop.

Then redim the new array to this size.

Then it should assign the relevant elements from the old array to the new array with the second loop. However it is not assigning the elements into the array as expected, it seems to be looping through fine, just not adding the new elements in. Any ideas?

Sub AddSelectDataFromBigArrayToSmallOne()

Dim PFAllArr As Variant
Dim PFArr As Variant
Dim c1, i1, c2, i2 As Long

PFAllArr = Sheets("PF File Simple").Range("A2").CurrentRegion.Value

'get number of elements i want to transfer to new array
c1 = 1
For i1 = LBound(PFAllArr) To UBound(PFAllArr)
    If PFAllArr(i1, 2) = 0 Then
    c1 = c1 + 1
    End If
Next i1

'Make new array this size
ReDim PFArr(LBound(PFAllArr) To c1, 1 To 4)

'Assign elements from old array nto new one
c2 = 1
For i2 = LBound(PFAllArr) To UBound(PFAllArr)
    If PFAllArr(i2, 2) = 0 Then
    PFArr(c2, 3) = PFAllArr(i2, 3)
    PFArr(c2, 4) = PFAllArr(i2, 4)
    c2 = c2 + 1
    End If
    Debug.Print c2, PFArr(c2, 3), PFArr(c2, 4)
Next i2

End Sub

Answer 1

Perhaps something like this?

Sub tgr()

    Dim aTemp As Variant
    Dim aData As Variant
    Dim iyTemp As Long
    Dim iyData As Long
    Dim ix As Long

    With ActiveWorkbook.Sheets("PF File Simple").Range("A2").CurrentRegion
        aTemp = .Value
        ReDim aData(1 To WorksheetFunction.CountIf(.Resize(, 1).Offset(, 1), 0), 1 To .Columns.Count)
    End With

    For iyTemp = 1 To UBound(aTemp, 1)
        If aTemp(iyTemp, 2) = 0 Then
            iyData = iyData + 1
            For ix = 1 To UBound(aTemp, 2)
                aData(iyData, ix) = aTemp(iyTemp, ix)
            Next ix
        End If
    Next iyTemp

    'aData is now populated with only values where the second column is 0

End Sub