Match two Arrays from different worksheets

hello,

I want to create a macro that matches each record from a worksheet I call "ATemplate" with another worksheet I call "BTemplate" using an unique ID (the ID row title is called "AT2RecID") that exists in both worksheets. For the sake of simplicity I only used several records as opposed to the thousands that I have in both worksheets. The workbook I provide with this post includes the following worksheets:

- ATemplate
- BTemplate
- Output Results

What I want the Macro to create in a new worksheet is the example found under worksheet "Output Results". In worksheet "Output Results" row titles should start IN ROW 2 and the data should start IN ROW 3. Row Titles B THROUGH M along with its associated data from worksheet "ATemplate" come over to the "Output Results" worksheet and Row Titles O and P along with its associated data from worksheet "BTemplate" come over to the "Output Results" worksheet. Again the records are matched up by the row title "AT2RecID" found in both worksheets "ATemplate" and "BTemplate". I understand I can do this in Access, but I would really like to see how it works in VBA.

thanks much!

Try this code

Sub copyfrom()

    Dim c3 As Range, c4 As Range, LR2 As String, LR1&, ms As Worksheet, At As Worksheet, Bt As Worksheet
    
    Application.ScreenUpdating = 0
    Application.EnableEvents = 0
    
    On Error Resume Next
    
    If Not Evaluate("ISREF('Output Results'!A1)") Then
        Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Output Results"
    Else
        Set ms = Sheets("Output Results")
        ms.Cells.ClearContents
   
   End If
    Set At = Sheets("ATemplate")
    Set Bt = Sheets("BTemplate")
    
With Bt

     LR2 = Bt.Cells(Rows.Count, 1).End(xlUp).Row
     LR1 = At.Cells(Rows.Count, 1).End(xlUp).Row
    
     At.Range("B1").Resize(, 12).Copy ms.Range("A2")
    .Range("O1").Resize(, 2).Copy ms.Range("M2")
    
    For Each c3 In .Range("B2:B" & LR2)
    
     Set c4 = At.Range("B2:B" & LR1).Find(c3, , xlValues, xlWhole)
    
        If Not c4 Is Nothing Then
           c4.Resize(, 12).Copy ms.Range("A" & Rows.Count).End(xlUp).Offset(1)
           c3.Offset(, 13).Resize(, 10).Copy ms.Cells(Rows.Count, 13).End(xlUp).Offset(1)
        End If
    Next
End With
       Application.ScreenUpdating = 1
       Application.EnableEvents = 1
       Set ms = Nothing: Set At = Nothing: Set Bt = Nothing
End Sub

Please see above amended code.

Another way

Option Explicit
Sub abc()
 Const shA As String = "ATemplate"
 Const shB As String = "BTemplate"
 Const shResults As String = "Output Results"
 
 Dim aArr, w, i As Long, ii As Long, n As Long
 Dim aOutput()
 Dim dic As Object
 
 With Worksheets(shA)
    aArr = .Range("a1").CurrentRegion
 End With
 
 Set dic = CreateObject("scripting.dictionary")
 
 ReDim w(UBound(aArr, 2) - 1)
 With dic
    .comparemode = 1
    For i = 2 To UBound(aArr)
        For ii = 2 To UBound(aArr, 2)
            w(ii - 2) = aArr(i, ii)
        Next
        .Item(aArr(i, 2)) = w
    Next
 End With
 
 With Worksheets(shB)
    aArr = .Range("a1").CurrentRegion
 End With
 
 ReDim aOutput(1 To UBound(aArr), 1 To 14)
 With dic
    For i = 2 To UBound(aArr)
        If .exists(aArr(i, 2)) Then
            n = n + 1: w = .Item(aArr(i, 2))
            For ii = 0 To UBound(w)
                aOutput(n, ii + 1) = w(ii)
            Next
            aOutput(n, 13) = aArr(i, 15)
            aOutput(n, 14) = CDbl(aArr(i, 16))
        End If
        
    Next
 End With
    
 If Not Evaluate("ISREF('" & shResults & "'!A1)") Then
    With Worksheets.Add(After:=Worksheets(Worksheets.Count))
        .Name = shResults
    End With
 End If

 With Worksheets(shResults)
    .Cells.Delete
    Worksheets(shA).Range("b1:m1").Copy .Range("a2")
    Worksheets(shB).Range("o1:p1").Copy .Range("m2")
    .Range("a3").Resize(n, UBound(aOutput, 2)) = aOutput
 End With
End Sub

BC,

They need to be variant.