Compare 2 columns of Sheet1 and Sheet2 and fetch data

[sofas]

Hello. I want to compare columns A and C in Sheet1 and Sheet2 If a match is obtained for the values, column B, E, F and G are copied from Sheet1 to Sheet 2 in column M for reference Sheet 1 starting from row 5 and Sheet 2 starting from row 11

 

[sofas]

Hello. is there any idea?

 

[alansidman]

Sure,
Bring both ranges/tables into Power Query. Join on common fields to find matching records. Power Query is found on the Data Tab and called Get and Transform Data in your version.

 

[sofas]

Sure,
Bring both ranges/tables into Power Query. Join on common fields to find matching records. Power Query is found on the Data Tab and called Get and Transform Data in your version.

Thank you but I prefer to get a solution by code VBA

 

[Alex Blakenburg]

This a bit long winded but see how you go with this.

Sub GetMatchedData()

    Dim srcSht As Worksheet, destSht As Worksheet
    Dim srcRng As Range, destKeyRng As Range, destOutRng As Range
    Dim srcArr As Variant, destKeyArr As Variant, destOutArr As Variant
    Dim srcLastRow As Long, destLastRow As Long
    Dim srcFirstRow As Long, destFirstRow As Long
    Dim srcRow As Long
    Dim i As Long
    
    Set srcSht = Worksheets("Sheet1")
    Set destSht = Worksheets("Sheet2")
    
    With srcSht
        srcFirstRow = 5
        srcLastRow = .Range("A" & .Rows.Count).End(xlUp).Row
        Set srcRng = .Range(.Cells(srcFirstRow, "A"), .Cells(srcLastRow, "G"))
        srcArr = srcRng.Value2
    End With

    With destSht
        destFirstRow = 11
        destLastRow = .Range("A" & .Rows.Count).End(xlUp).Row
        Set destKeyRng = .Range(.Cells(destFirstRow, "A"), .Cells(destLastRow, "C"))
        destKeyArr = destKeyRng.Value2
        Set destOutRng = .Cells(destFirstRow, "M")
        ReDim destOutArr(1 To UBound(destKeyArr, 1), 1 To 4)    ' 4 columns B E F G
    End With

    Dim dictSrc As Object, dictKey As String

    Set dictSrc = CreateObject("Scripting.dictionary")
    
    ' Load source range into Dictionary
    For i = 1 To UBound(srcArr)
        dictKey = srcArr(i, 1) & "|" & srcArr(i, 3)
        If Not dictSrc.exists(dictKey) Then
            dictSrc(dictKey) = i
        End If
    Next i

    For i = 1 To UBound(destKeyArr)
        dictKey = destKeyArr(i, 1) & "|" & destKeyArr(i, 3)
        If dictSrc.exists(dictKey) Then
            srcRow = dictSrc(dictKey)
            destOutArr(i, 1) = srcArr(srcRow, 2)
            destOutArr(i, 2) = srcArr(srcRow, 5)
            destOutArr(i, 3) = srcArr(srcRow, 6)
            destOutArr(i, 4) = srcArr(srcRow, 7)
        End If
    Next i
    
    destOutRng.Resize(UBound(destOutArr, 1), UBound(destOutArr, 2)) = destOutArr

End Sub

 

[sofas]

This a bit long winded but see how you go with this.

Sub GetMatchedData()

    Dim srcSht As Worksheet, destSht As Worksheet
    Dim srcRng As Range, destKeyRng As Range, destOutRng As Range
    Dim srcArr As Variant, destKeyArr As Variant, destOutArr As Variant
    Dim srcLastRow As Long, destLastRow As Long
    Dim srcFirstRow As Long, destFirstRow As Long
    Dim srcRow As Long
    Dim i As Long
    
    Set srcSht = Worksheets("Sheet1")
    Set destSht = Worksheets("Sheet2")
    
    With srcSht
        srcFirstRow = 5
        srcLastRow = .Range("A" & .Rows.Count).End(xlUp).Row
        Set srcRng = .Range(.Cells(srcFirstRow, "A"), .Cells(srcLastRow, "G"))
        srcArr = srcRng.Value2
    End With

    With destSht
        destFirstRow = 11
        destLastRow = .Range("A" & .Rows.Count).End(xlUp).Row
        Set destKeyRng = .Range(.Cells(destFirstRow, "A"), .Cells(destLastRow, "C"))
        destKeyArr = destKeyRng.Value2
        Set destOutRng = .Cells(destFirstRow, "M")
        ReDim destOutArr(1 To UBound(destKeyArr, 1), 1 To 4)    ' 4 columns B E F G
    End With

    Dim dictSrc As Object, dictKey As String

    Set dictSrc = CreateObject("Scripting.dictionary")
    
    ' Load source range into Dictionary
    For i = 1 To UBound(srcArr)
        dictKey = srcArr(i, 1) & "|" & srcArr(i, 3)
        If Not dictSrc.exists(dictKey) Then
            dictSrc(dictKey) = i
        End If
    Next i

    For i = 1 To UBound(destKeyArr)
        dictKey = destKeyArr(i, 1) & "|" & destKeyArr(i, 3)
        If dictSrc.exists(dictKey) Then
            srcRow = dictSrc(dictKey)
            destOutArr(i, 1) = srcArr(srcRow, 2)
            destOutArr(i, 2) = srcArr(srcRow, 5)
            destOutArr(i, 3) = srcArr(srcRow, 6)
            destOutArr(i, 4) = srcArr(srcRow, 7)
        End If
    Next i
    
    destOutRng.Resize(UBound(destOutArr, 1), UBound(destOutArr, 2)) = destOutArr

End Sub

Very cool as if you knew what I want exactly thank you very much . Lasting creativity as usual

 

[Alex Blakenburg]

Thanks for letting me know. Glad I could help.