if column "a" in sheet1 matches column "a" in sheet2 then replace entire row in-CodePudding

So I have been digging for an answer for a few hours now, I have found similar cases, but none of them is exact to what I am looking for.

Hope to find your help (if this is actually possible). Let me explain shortly the idea behind this practice.

I have two different sheets (sheet1 and sheet2) and I would like to compare column A in sheet1 to column A in sheet2.

If the values are perfect match, I would like to copy data from sheet2 into sheet1 into the row that matches values.

The data I am working on is sensitive date, so I have created an example to paste here - hope this is understandable:

As you can see on the screen, if value from column A (sheet1) matches the value in column B (sheet2) then it result in replacing specific data in columns in sheet1.

I hope this is understandable and you will be able to help with this case.

How I can get this resolved? I am completely new to VBA/macros and would love to learn from you guys.

CodePudding user response：

Use a Dictionary Object to match header names on sheet2 with those on sheet1.

update - added trim to convert numbers to strings

Option Explicit

Sub Update()

    Const ROW_HEADER = 1

    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim lastrow As Long, lastcol As Long, r As Long, c As Long
    Dim arID, id As String, n As Long, m As Variant
    
    Dim dictCol As Object, k As String
    Set dictCol = CreateObject("Scripting.Dictionary")
   
   ' profile sheet2 columns
    Set ws2 = ThisWorkbook.Sheets("Sheet2")
    With ws2
        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        arID = .Range("A1:A" & lastrow).Value2 ' range of iDs
        
        lastcol = .Cells(ROW_HEADER, .Columns.Count).End(xlToLeft).Column
        For c = 1 To lastcol
            k = Trim(.Cells(ROW_HEADER, c)) ' header text
            If dictCol.exists(k) Then
                MsgBox "Duplicate header '" & k & "' at column " & c, vbCritical
                Exit Sub
            ElseIf Len(k) > 0 Then
                dictCol(k) = c ' column number
            End If
        Next
    End With

    For r = 1 To UBound(arID): arID(r, 1) = Trim(arID(r, 1)): Next
    MsgBox dictCol.Count & " columns found on sheet " & ws2.Name, vbInformation
    
    ' update sheet1
    Set ws1 = ThisWorkbook.Sheets("Sheet1")
    With ws1
        lastcol = .Cells(ROW_HEADER, .Columns.Count).End(xlToLeft).Column
        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        For r = 2 To lastrow
            id = Trim(.Cells(r, "A"))
            
            ' locate row on sheet2
            m = Application.Match(id, arID, 0)
            If Not IsError(m) Then
                ' scan columns
                For c = 2 To lastcol
                    k = trim(.Cells(ROW_HEADER, c))
                    ' find col on sheet2
                    If dictCol.exists(k) Then
                        ' update if different
                        If .Cells(r, c) <> ws2.Cells(m, dictCol(k)) Then
                            .Cells(r, c).Interior.Color = RGB(255, 255, 0) ' mark yellow for checking
                            .Cells(r, c) = ws2.Cells(m, dictCol(k))
                            n = n   1
                         End If
                    Else
                        MsgBox "Column " & k & " not found", vbCritical
                        Exit Sub
                    End If
                Next
            Else
                Debug.Print id, m
            End If
        Next
    End With
    
    ' end
    MsgBox lastrow - 1 & " rows scanned " & vbLf & _
           n & " cells updated", vbInformation
   
End Sub