Thread: Need a Macro for Compare and copy data from one sheet to another sheet in Excel.

Hi All,

I am new to Excel Macros and need experts Help, I was stuck up at Compare and copy data from one sheet to another sheet in Excel 2007.

I have a excel workbook which contains 3 sheets(sheet1 , sheet2 and sheet3). Sheet1 is master sheet of sheet2 and sheet3 means it will get data from these 2 sheets, so sheet1 columns are combination of sheet2 & sheet3 columns.

sheet2 & sheet3 are linked with different external sources and when ever changes will occur in external sources automatically these two sheets will get updated . so always these sheets are having latest data .

but sheet1 is getting data from sheet2 and sheet3, sheet1 is not updating every time when sheet3 got update ,since we are not automated the connection between sheet1 and sheet3.

our objective of this Macro is , it should compare the sheet1 and sheet3 based on Request Number(it is a unique and common column in both sheets) and needs to copy the whole row corresponding to the request number from sheet3 which does not exists in sheet1 and paste the data into corresponding columns in sheet1. we need to make sure that no duplicate values are occurred in Request Number in sheet1.( example sheet1 have 10 rows and sheet3 have 13 rows, in both sheets 10 rows are identical and remaining 3 rows added newly in sheet3. now we need to copy those 3 rows into sheet1 into corresponding coulmns)

here i have attached the macro code, it is working fine up to some content but not satisfying my requirement.

Any help would be highly appreciated.

thanks in advance.

Regards,
Mallesham

It will be good if you attach the workbook as well.

Use this code. It will create a sheet called Temp for the comparisons and delete it at the end.

Option Explicit
Dim lrow As Long
Dim i As Long
Dim Trow1 As Long
Dim Trow2 As Long
Dim rcell As Range

Sub compare_rows()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Temp"
Worksheets("Temp").Range("A1").Value = "Req No"
Worksheets("Temp").Range("B1").Value = "Sheet"
lrow = Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
Worksheets("Sheet1").Range("M2:M" & lrow).Copy Worksheets("Temp").Range("A2")
Worksheets("Temp").Range("B2:B" & lrow).Value = "Sheet1"

lrow = Worksheets("Sheet3").Range("A" & Rows.Count).End(xlUp).Row
Worksheets("Sheet3").Range("I2:I" & lrow).Copy Worksheets("Temp").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
Trow1 = Worksheets("Temp").Range("B" & Rows.Count).End(xlUp).Row
Trow2 = Worksheets("Temp").Range("A" & Rows.Count).End(xlUp).Row
Worksheets("Temp").Range("B" & Trow1 + 1 & ":B" & Trow2).Value = "Sheet3"


ActiveWorkbook.Worksheets("Temp").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Temp").Sort.SortFields.Add Key:=Range("A:A") _
    , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Temp").Sort
    .SetRange Range("A:B")
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

With Worksheets("Temp")
    lrow = .Range("B" & Rows.Count).End(xlUp).Row

    For i = lrow To 2 Step -1
        If .Range("A" & i).Value = .Range("A" & i - 1).Value And .Range("B" & i).Value <> .Range("B" & i - 1).Value Then
            .Rows(i & ":" & i - 1).Delete
            lrow = lrow - 2
        End If
    Next i
End With

lrow = Worksheets("Temp").Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To lrow
    Set rcell = Worksheets("Sheet3").Cells.Find(What:=Worksheets("Temp").Range("A" & i).Value, After:=Worksheets("Sheet3").Range("A1"), LookIn:=xlValues, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
     Worksheets("Sheet3").Range("A" & rcell.Row & ":H" & rcell.Row).Copy Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
     Worksheets("Sheet1").Range("M" & Rows.Count).End(xlUp).Offset(1, 0).Value = rcell
Next i

Worksheets("Temp").Delete

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

You said we need to copy the whole row into sheet1. However, if you check your attachment, the number of columns in Sheet3 do not match with Sheet1.