How to perform Application.Match function in an array for multiple columns

Question

I currently have a VBA code where I do several lookups between a master sheet and multiple data-sheets, using the Application.Match function. If there's a match in the lookup in one of the sub-sheets, I paste the corresponding value to the master sheet. I do this for twelve columns in the master sheet (one for each month).

My code is running very slow and I suspect it's due to the fact that I'm not using arrays, and hence does a lot of printing into individual cells while running the code. I would like to speed up performance using arrays, but I can't really figure out how to convert my existing code, where I paste to ranges in a for loop, to printing to an array instead.

My code looks like this:

Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False

    With aSheet
    
    For i = FindEmptyRow To FindRow
        mtchrw = 0
        On Error Resume Next
            mtchrw = Application.WorksheetFunction.Match(.Range("A" & i), Sheets("datasheet1").Range("A:A"), 0)
        On Error GoTo 0
        If mtchrw > 0 Then
            Sheets("datasheet1").Range("B" & mtchrw & ":B" & mtchrw).Copy
                .Range("B" & i & ":B" & i).PasteSpecial Paste:=xlPasteValues 
            Sheets("datasheet1").Range("C" & mtchrw & ":C" & mtchrw).Copy
                .Range("D" & i & ":D" & i).PasteSpecial Paste:=xlPasteValues 
            Sheets("datasheet1").Range("D" & mtchrw & ":D" & mtchrw).Copy
                .Range("F" & i & ":F" & i).PasteSpecial Paste:=xlPasteValues 
            Sheets("datasheet1").Range("E" & mtchrw & ":E" & mtchrw).Copy
                .Range("H" & i & ":H" & i).PasteSpecial Paste:=xlPasteValues 
            Sheets("datasheet1").Range("F" & mtchrw & ":F" & mtchrw).Copy
                .Range("J" & i & ":J" & i).PasteSpecial Paste:=xlPasteValues 
            Sheets("datasheet1").Range("G" & mtchrw & ":G" & mtchrw).Copy
                .Range("L" & i & ":L" & i).PasteSpecial Paste:=xlPasteValues 
            Sheets("datasheet1").Range("H" & mtchrw & ":H" & mtchrw).Copy
                .Range("N" & i & ":N" & i).PasteSpecial Paste:=xlPasteValues 
            Sheets("datasheet1").Range("I" & mtchrw & ":I" & mtchrw).Copy
                .Range("P" & i & ":P" & i).PasteSpecial Paste:=xlPasteValues 
            Sheets("datasheet1").Range("J" & mtchrw & ":J" & mtchrw).Copy
                .Range("R" & i & ":R" & i).PasteSpecial Paste:=xlPasteValues 
            Sheets("datasheet1").Range("K" & mtchrw & ":K" & mtchrw).Copy
                .Range("T" & i & ":T" & i).PasteSpecial Paste:=xlPasteValues 
            Sheets("datasheet1").Range("L" & mtchrw & ":L" & mtchrw).Copy
                .Range("V" & i & ":V" & i).PasteSpecial Paste:=xlPasteValues 
            Sheets("datasheet1").Range("M" & mtchrw & ":M" & mtchrw).Copy
                .Range("X" & i & ":X" & i).PasteSpecial Paste:=xlPasteValues 
        End If
    Next i
End With

In my datasheet, the columns are adjecent to each other, while in my master sheet, there's a column in between each. That's the reason I have split up the copy/paste function in twelve parts, if that makes sense.

How would I go about doing this task using an array, where I avoid doing the copy/paste-function in twelve parts?

I apologize for my english. It's not my first language.

Kind regards, Magnus

edit: FindRow and FindEmptyRow reflects the first and last row in column A in the aSheet. Snapshot of aSheet

Snapshot of datasheet1:

The values from datasheet1 are multiplied by 37 before being pasted to master sheet.

Can you post a snapshot of the aSheet, datasheet1 and explain the values of FindEmptyRow and FindRow? — Elio Fernandes
– Elio Fernandes, Commented Sep 1, 2021 at 11:34
How many rows are you looping through? Instead of copy/paste you can use .Range("B" & i).value=Sheets("datasheet1").Range("B" & mtchrw).value which is more efficient. — SJR
– SJR, Commented Sep 1, 2021 at 11:57

Elio Fernandes · Accepted Answer · 2021-09-01 15:57:17Z

1

Try this.

Sub CopyValues()
    Dim rw As Integer: rw = 0
    Dim ws1 As Worksheet: Set ws1 = Sheets("Master")
    Dim ws2 As Worksheet: Set ws2 = Sheets("datasheet1")
    Dim nRng As Range: Set nRng = ws1.Range("A3", ws1.Range("A3").End(xlDown))
    Dim vRng As Range, nCell As Range
    Dim i As Integer, col As Integer: col = 3
    
    Dim arr As Variant
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    For Each nCell In nRng
        On Error Resume Next
            rw = Application.WorksheetFunction.Match(nCell, ws2.Range("A:A"), 0)
        On Error GoTo 0
        
        ' If match found
        If rw > 0 Then
            ' copy range of values to array
            Set vRng = ws2.Range(ws2.Cells(rw, 2), ws2.Cells(rw, 13))
            arr = Application.Transpose(Application.Transpose(vRng))
            
            ' Loop through array and copy values
            For i = 1 To UBound(arr)
               ws1.Cells(nCell.Row, col).Value = arr(i)
               col = col + 2
            Next i
        End If
        
        ' Restore inicial values
        rw = 0
        col = 3
    Next nCell
    
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

edited Sep 1, 2021 at 15:57

answered Sep 1, 2021 at 14:43

Elio Fernandes

1,4302 gold badges16 silver badges30 bronze badges

Sign up to request clarification or add additional context in comments.

5 Comments

Tim Williams Over a year ago

FYI you forgot to reset rw at the top of each loop before running the Match...

Elio Fernandes Over a year ago

@Tim Williams, thanks for the information! Can you tell how can I set a background color in a comment as you just did for rw and Match?

Tim Williams Over a year ago

You can format text as "code" in comments by surrounding it with back-ticks ``

Magnus Carstens Over a year ago

@ElioFernandes Thank you so much!! Works like a charm.

Elio Fernandes Over a year ago

@Magnus Carstens, If it was helpful, put a check on it!

Collectives™ on Stack Overflow

How to perform Application.Match function in an array for multiple columns

1 Answer 1

5 Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

5 Comments

Your Answer

Sign up or log in

Post as a guest

Related