Excel Macro - Compare 2 rows and copy duplicate

Question

Is it possible to have a macro run to find duplicate information from page 1 and 2 then copy it to the third?

For example.. Search through Sheet 1 - A1 to bottom of the data Compare this with Sheet 2 A1 to bottom of the data

If a duplicate is found then copy that row to Sheet 3?

Then loop this?

I've had a look around, But nothing works if the data is in random order.

`I've had a look around, But nothing works if the data is in random order.` -show us your attempts please — Dmitry Pavliv, Feb 19 '14 at 08:40
@simoco here's one I found, But it doesn't work.. It only copies the headers. http://stackoverflow.com/questions/19320017/in-excel-how-to-compare-a-columns-in-2-sheets-and-copy-matching-rows-to-sheet3 — Jacko058, Feb 19 '14 at 08:43
Yes, But say if the data on Sheet 1 is located A4 and on Sheet 2 its located on A5 then they don't compare & don't copy. — Jacko058, Feb 19 '14 at 08:45
@L42 each time the data could be different, Hopefully I've got the code working. Fingers crossed ! — Jacko058, Feb 19 '14 at 09:08
and you only copy duplicate rows from Sheet1 or both sheet1 and sheet2? Like you consolidate all the duplicates in Sheet3? — L42, Feb 19 '14 at 09:16
@L42 I've sorted it now.. few! I basically compared sheet 1 with sheet 2, If sheet 1 was on sheet 2 then copy shee1 to sheet 3. .. Sorry, When I say sheet I mean a sheet cell. — Jacko058, Feb 19 '14 at 10:23
oh ok, since your at it, just come back if you got stuck somewhere. Post your code here and the error you are getting just in case. good luck! :) — L42, Feb 20 '14 at 00:59

score 4 · Answer 1 · edited Feb 21 '14 at 21:33

dim i as integer
dim j as integer
dim counter as integer
dim flagMatch as boolean

counter = 1

for i = 1 to 'number of rows in sheet1
    flagMatch = false
    for j = 1 to 'number of row in sheet2
        if sheet1.cells(i, 1) = sheet2.cells(j, 1) then
            flagMatch = true
        end if
    next j
next i
if flagMatch = true then
    sheet3.cells(counter, 1) = sheet1.cells(i, 1)
    counter = counter + 1
end if

score 2 · Answer 2 · answered Feb 19 '14 at 12:01

You can try this:

Sub CopyDuplicates()
Dim w1, w2, w3, ws, v, p
Dim r1 As Long, r3 As Long, nr As Long
Set w1 = Sheets(1)
Set w2 = Sheets(2)
Set w3 = Sheets(3)
r1 = 1
r3 = 1
On Error GoTo TheEnd
Application.ScreenUpdating = False
nr = w2.Cells(1, 1).End(xlDown).Row
Set ws = w2.Range(w2.Cells(1, 1), w2.Cells(nr, 1))
Do While Not IsEmpty(w1.Cells(r1, 1))
 v = w1.Cells(r1, 1)
 p = Application.Match(v, ws, 0)
 If Not IsError(p) Then
  w1.Rows(r1).Copy Destination:=w3.Rows(r3)
  r3 = r3 + 1
 End If
 r1 = r1 + 1
Loop
TheEnd:
Application.ScreenUpdating = True
End Sub

Excel Macro - Compare 2 rows and copy duplicate

2 Answers2