Hi,

I have two sheets (Header & Item) in one file. Header has 25k and Item 50k rows. I'm looping through col B in Header and looking values in col B in Item and when we have a match then copying some values from Header-sheet to Item-sheet. I want this to be as fast as possible.

I have two different macros to do this, both doing what I want and working basically fine. One uses arrays and the other one not. I read about arrays and thought that they should make this faster but the results are quite contrary. Array macro takes 336 seconds and the other one 42 seconds to accomplish.

Is there something terribly wrong with my array macro or why is it so slow...? If there are any other comments or best practises concerning these macros, I would be glad to hear them. Thanks!

Sub test_array()

Dim i As Long
Dim Header_dummy As Variant, Item_dummy As Variant, Ws1 As Worksheet, Ws2 As Worksheet
Dim LRow As Long, x As Long, targetArr As Variant, sourceArr As Variant
Dim startT As Double, endT As Double

Application.ScreenUpdating = False

startT = Timer

Set Ws1 = Sheets("Header")
Set Ws2 = Sheets("Item")

'declare arrays
LRow = Ws1.Cells(Application.Rows.Count, 2).End(xlUp).Row
Header_dummy = Ws1.Range("B3:B" & LRow).Value2
sourceArr = Ws1.Range("F3:H" & LRow).Value2

LRow = Ws2.Cells(Application.Rows.Count, 2).End(xlUp).Row
Item_dummy = Ws2.Range("B3:B" & LRow).Value2
targetArr = Ws2.Range("T3:V" & LRow).Value2

For i = 1 To UBound(Header_dummy)
               
        'first match
        On Error Resume Next
        x = Application.WorksheetFunction.Match(Header_dummy(i, 1), Item_dummy, 0)
        On Error GoTo 0
                
        If x <> 0 Then
            'copy values to target array
            targetArr(x, 1) = sourceArr(i, 1)
            targetArr(x, 2) = sourceArr(i, 2)
            targetArr(x, 3) = sourceArr(i, 3)
            
        End If
        
        x = 0
    
Next i

'copy array to item sheet
Ws2.Range("T3:V" & LRow) = targetArr

endT = Timer
Application.ScreenUpdating = True
MsgBox endT - startT

End Sub
And the other macro as well:

Sub Fill_in_item()

Dim Ws5 As Worksheet, Ws4 As Worksheet
Dim LRowWs4 As Long, LRowWs5 As Long
Dim rowId As Range, i As Long, MatchRow As Long
Dim startT As Double, endT As Double

Application.ScreenUpdating = False

startT = Timer

Set Ws4 = Sheets("Header")
Set Ws5 = Sheets("Item")

Ws5.Activate

LRowWs4 = Ws4.Cells(Application.Rows.Count, 2).End(xlUp).Row
LRowWs5 = Ws5.Cells(Application.Rows.Count, 2).End(xlUp).Row

Set rowId = Range(Ws5.Cells(1, 2), Ws5.Cells(LRowWs5, 2))
'Debug.Print rowId.Address

For i = 3 To LRowWs4
       
    'find match & copy values
    MatchRow = WorksheetFunction.Match(Ws4.Cells(i, 2), rowId, 0)

    Range(Ws5.Cells(MatchRow, 20), Ws5.Cells(MatchRow, 22)).Value = Range(Ws4.Cells(i, 6), Ws4.Cells(i, 8)).Value

Next

endT = Timer

MsgBox endT - startT

Application.ScreenUpdating = True

End Sub