VBA Copy data from Array to another help

[mse330]

Hi all,

I am learning more about Arrays but I got to this point & I am stuck & need some help here. So in "Sheet1" I have a list of data that spreads for about 17k rows & over 9 columns & in "Sheet2" I have list of values that I type in column A which then I am looping against my data from Sheet1 & inserting the results in a new sheet. I have already searched & read a lot about arrays but I am still facing the below issues:

​

• I read that "ReDim Preserve" can only work with the last dimension of the array which I don't need to change in my case - I need to change the first dimension which is the rows
• How can I copy the data from Arr to Arr2 if the condition is met (all row data from 9 columns)
• I have read a post here few days ago that it's better not to use ReDim extensively in a loop & rather define a larger size Arr2 & then ReDim only once after completion - How could I accomplish this ?

This is my code so far, any guidance on how to complete it would be highly appreciate it

Sub FilterData()

Dim Ws1 As Worksheet, Ws2 As Worksheet, Ws3 As Worksheet
Dim lRow As Long, Arr() As Variant, Arr2() As Variant

Set Ws1 = Sheet1 'All Data
Set Ws2 = Sheet2 'Look up list
Set Ws3 = Sheet3 'Sheets.Add(After:=Sheets(Sheets.Count))
Set Rg = Ws1.Range("A1").CurrentRegion
Arr() = Rg.Value ' For my file currently it's (1 to 17270, 1 to 9)
lRow = Ws2.Range("A" & Rows.Count).End(xlUp).Row

For x = 2 To lRow
    For i = LBound(Arr) To UBound(Arr)
        If Arr(i, 4) = Ws2.Cells(x, 1).Value Then
            y = y + 1 'counting row numbers in Array
            ReDim Preserve Arr2(1 To y, 1 To Rg.Columns.Count)
            ' How to assign data from Arr1 to Arr2 for all 9 columns ?
        End If
    Next i
Next x

Ws3.Range("A1").Resize(UBound(Arr2, 1), UBound(Arr2, 2)) = Arr2

End Sub

 

[Fluff]

How about

Sub FilterData()

Dim Ws1 As Worksheet, Ws2 As Worksheet, Ws3 As Worksheet
Dim Arr As Variant, Arr2() As Variant

Set Ws1 = Sheet1 'All Data
Set Ws2 = Sheet2 'Look up list
Set Ws3 = Sheet3 'Sheets.Add(After:=Sheets(Sheets.Count))
Set rg = Ws1.Range("A1").CurrentRegion

Arr = rg.Value ' For my file currently it's (1 to 17270, 1 to 9)
ReDim Arr2(1 To UBound(Arr), 1 To UBound(Arr, 2))

With CreateObject("scripting.dictionary")
   For Each Cl In Ws2.Range("A2", Ws2.Range("A" & Rows.Count).End(xlUp))
      If Not .exists(Cl.Value) Then .Add Cl.Value, Nothing
   Next Cl
    For i = LBound(Arr) To UBound(Arr)
        If .exists(Arr(i, 4)) Then
            y = y + 1 'counting row numbers in Array
            For c = 1 To UBound(Arr, 2)
               Arr2(y, c) = Arr(i, c)
            Next c
        End If
    Next i
End With

Ws3.Range("A1").Resize(y, UBound(Arr2, 2)) = Arr2

End Sub

 

[mse330]

Thanks a lot Fluff ... This works perfectly !!

May I ask couple of questions for my understanding:
1. You used scripting dictionary to enhance the performance of the code instead of reading form the sheet continuously ?
2. I have to use a loop to get each "column" data of the same row to the new Array ?! No other options ?
3. Do we need to ReDim Arr2 after completion of the loop & before pasting data to the sheet or it has no effect ?

Again thanks a lot

 

[Fluff]

1. Partially correct. For each row in ws2 your code compares the value to each value in the array. So if ws2 has 1000 values & the array has 17270 you will be doing over 17 million comparisons.
Whereas using the dictionary, you simply check if the value exists or not which cancels out the loop
2. There are other options, but that's how I tend to do it.
3. You could redim arr2, but I'm not sure there's much point.

 

[mse330]

Thank you so much for the clarifications. Much appreciated

 

[Fluff]

You're welcome