Match duplicates and copy updated cells from one worksheet to another

[markpem]

Hello
I currently have two sheets (sheet1 and sheet2) with (some) duplicate data in, and would like any data that is on sheet2 to find a match in sheet1 and then update any cells along that row in sheet2 which contain data and paste that into sheet1.

It's a little hard to explain so I have attached a screenprint if anyone could help me with some vba code.

Thanks

 

[Kprajath]

Kprajath

Hi Markpem
Refer file attached. Try the code below:

Sub Updaterecords()
'Procedure written by Krisnaprasad Menon-Mumbai-India
'Procedure to take a record from sheet1, search it in sheet 2 and if a match is found,
'get cells with entries copied to 1st sheet
'Find last row numbers in both sheets
Application.ScreenUpdating = False 'hides Screen activity
Sheets("Sheet1").Select
S1Lrow = Cells(Rows.Count, 1).End(xlUp).Row
S1Lrow = S1Lrow - 1 'To reduce one row, which is Col heading row
Dim S1Rnum As String  'Variable to increment Row numbers in Sheet1
Dim S2Rnum As String  'Variable to increment Row numbers in Sheet2
Dim S1Ccell As String 'To Define current cell address in Sheet1
Dim S2Ccell As String 'To Define current cell address in Sheet2
Dim Sno1 As Integer
Dim S1Count As Integer
Dim Chkname1 As String 'To store the name in sheet1 if the cell is not blank.
Dim Chkname2 As String 'To store the name in sheet2 if the cell is not blank.
    S1Rnum = 2 'In this example, target cell starts from A2
    S2Rnum = 2 'In this example, target cell starts from A2
S1Ccell = "A" & S1Rnum 'Current Cell of Sheet1 is defined as "A2"
S2Ccell = "A" & S2Rnum 'Current Cell of Sheet2 is defined as "A2"
       
Sno1 = 1
For S1Count = 1 To S1Lrow 'Not overshoot last row number of Sheet1
Range(S1Ccell).Select
Chkname1 = Range(S1Ccell) 'Data in currently checking cell of Sheet1 stored


'Now go to sheet2 to find the match
Sheets("Sheet2").Select
Range(S2Ccell).Select
Chkname2 = Range(S2Ccell) 'Data in currently checking cell of Sheet2 stored


If Chkname1 = Chkname2 Then 'Compare data of current Cell of Col "A" in both Sheets and
'if a match is found, store data of cells across columns of sheet2 (from col B to Col M)
'This values will be checked for not blank, ie. length must be > 0 to paste in sheet1
    Col1 = "B" & S2Rnum
    Range(Col1).Select
    cur1 = Range(Col1)
    
    Col2 = "C" & S2Rnum
    Range(Col2).Select
    cur2 = Range(Col2)
    
    Col3 = "D" & S2Rnum
    Range(Col3).Select
    cur3 = Range(Col3)
    
    Col4 = "E" & S2Rnum
    Range(Col4).Select
    cur4 = Range(Col4)
    
    Col5 = "F" & S2Rnum
    Range(Col5).Select
    cur5 = Range(Col5)




    Col6 = "G" & S2Rnum
    Range(Col6).Select
    cur6 = Range(Col6)




    Col7 = "H" & S2Rnum
    Range(Col7).Select
    cur7 = Range(Col7)


    Col8 = "I" & S2Rnum
    Range(Col8).Select
    cur8 = Range(Col8)


    Col9 = "J" & S2Rnum
    Range(Col9).Select
    cur9 = Range(Col9)


    Col10 = "K" & S2Rnum
    Range(Col10).Select
    cur10 = Range(Col10)


    Col11 = "L" & S2Rnum
    Range(Col11).Select
    cur11 = Range(Col11)


    Col12 = "M" & S2Rnum
    Range(Col12).Select
    cur12 = Range(Col12)


    Col13 = "N" & S2Rnum
    Range(Col13).Select
    cur13 = Range(Col13)


    Col14 = "O" & S2Rnum
    Range(Col14).Select
    cur14 = Range(Col14)


'Go back to sheet1 again
    Sheets("Sheet1").Select


'If stored value are not blank, then paste it in corresponding cells of sheet1
    If Len(cur1) > 0 Then
    Range(Col1).Select
    ActiveCell.FormulaR1C1 = cur1
    End If


    If Len(cur2) > 0 Then
    Range(Col2).Select
    ActiveCell.FormulaR1C1 = cur2
    End If
       
    If Len(cur3) > 0 Then
    Range(Col3).Select
    ActiveCell.FormulaR1C1 = cur3
    End If
       
       
    If Len(cur4) > 0 Then
    Range(Col4).Select
    ActiveCell.FormulaR1C1 = cur4
    End If
       
    If Len(cur5) > 0 Then
    Range(Col5).Select
    ActiveCell.FormulaR1C1 = cur5
    End If
       
    If Len(cur6) > 0 Then
    Range(Col6).Select
    ActiveCell.FormulaR1C1 = cur6
    End If
       
    If Len(cur7) > 0 Then
    Range(Col7).Select
    ActiveCell.FormulaR1C1 = cur7
    End If
        
    If Len(cur8) > 0 Then
    Range(Col8).Select
    ActiveCell.FormulaR1C1 = cur8
    End If
       
    If Len(cur9) > 0 Then
    Range(Col9).Select
    ActiveCell.FormulaR1C1 = cur9
    End If
       
    If Len(cur10) > 0 Then
    Range(Col10).Select
    ActiveCell.FormulaR1C1 = cur10
    End If
       
    If Len(cur11) > 0 Then
    Range(Col11).Select
    ActiveCell.FormulaR1C1 = cur11
    End If
       
    If Len(cur12) > 0 Then
    Range(Col12).Select
    ActiveCell.FormulaR1C1 = cur12
    End If
       
    If Len(cur13) > 0 Then
    Range(Col13).Select
    ActiveCell.FormulaR1C1 = cur13
    End If
       
    If Len(cur14) > 0 Then
    Range(Col14).Select
    ActiveCell.FormulaR1C1 = cur14
    End If
'Pasting of non-blank values completed now. Exit endif block and increment counter by 1
End If 'End of condition if Chknam1 = Chkname2


Sno = Sno + 1 ' Counter incremented by 1, to keep it going till equivalent to Last Row Number
S1Rnum = S1Rnum + 1 'Row counter for sheet 1 incremented by 1
S2Rnum = S2Rnum + 1 'Row counter for sheet 2 incremented by 1
S1Cell = "A" & S1Rnum 'Cell address updated to jump into next row in sheet 1
S2Cell = "A" & S2Rnum 'Cell address updated to jump into next row in sheet 2
Next S1Count
End Sub 'End of loop to exit on completion upto last row