VBA macro to loop through cells, find matches, and copy adjacent cells

Question

I'm looking to have a macro that, when run, will look for matches in two columns (column M on the DISPLAY sheet and column A on the REPORT_DOWNLOAD sheet), and then when there's a match copy the adjacent 3 cells on the REPORT_DOWNLOAD sheet (cells B, C & D) and paste them in cells S, T & U respectively of the DISPLAY sheet.

There will only be one match for each cell. I've tried to work off some previous vba code that was looking for multiple instances of each match, but I think I've confused myself too much at this point:(

Any help would be greatly appreciated.

Sub Display()

Dim ws1 As Worksheet, ws2 As Worksheet
Set ws1 = ThisWorkbook.Sheets("DISPLAY")
Set ws2 = ThisWorkbook.Sheets("REPORT_DOWNLOAD")

Dim arr_1 As Variant, arr_2 As Variant, arr_result As Variant
arr_1 = ws1.Range("K2:K" & ws2.Range("D" & ws2.Rows.Count).End(xlUp).Row).Value2
arr_2 = ws2.Range("A2:L" & ws2.Range("A" & ws2.Rows.Count).End(xlUp).Row).Value2

ReDim arr_result(LBound(arr_2) To UBound(arr_2), 1 To 3)

Dim i As Long, j As Long

For i = LBound(arr_1, 1) To UBound(arr_1, 1)
    For j = LBound(arr_2, 1) To UBound(arr_2, 1)

        If arr_1(i, 1) = arr_2(j, 1) Then
  
            arr_result(i, 1) = arr_2(j, 6)
            arr_result(i, 2) = arr_2(j, 7)
            arr_result(i, 3) = arr_2(j, 8)
        End If

    Next j
Next i

ws1.Cells(2, 17).Resize(UBound(arr_result, 1), 3).Value2 = arr_result

End Sub

Answer 1

This is usually done like this:

Sub updateDisplayList()
Rem Just define work sheets:
Dim wsSource As Worksheet: Set wsSource = Worksheets("REPORT_DOWNLOAD")
Dim wsTarget As Worksheet: Set wsTarget = Worksheets("DISPLAY")
Rem
Dim rSearch As Range, rWhat As Range, rBase As Range, oCell As Range
Dim vVar As Variant
Rem Column A of source sheet:
    Set rSearch = Application.Intersect(wsSource.UsedRange, wsSource.Columns(1)).Offset(1, 0)
Rem 3 first cells in columns which will be copied
    Set rBase = wsSource.Range("B1:D1")
Rem Range with data to search: used part of column M
    Set rWhat = Application.Intersect(wsTarget.UsedRange, wsTarget.Range("M:M"))
    For Each oCell In rWhat
        If Not IsEmpty(oCell) Then
            vVar = Application.Match(oCell.Value, rSearch, 0)
            If Not IsError(vVar) Then
                rBase.Offset(vVar, 0).Copy Destination:=oCell.Offset(0, 6)
Rem If you want to clear target cells when value not found in source sheet:
            Else
                oCell.Offset(0, 6).Resize(1, 3).ClearContents
            End If
        End If
    Next oCell
End Sub

(Not sure about column M - in your code you use values of column K)