comparing data sets

[piper6]

Hey everyone,

Hope this is an easy question. I'm trying to compare data in two separate sheets. There are 12 columns in total, and each row represents one transaction. I'd like to create a macro that looks at both sheets, copies the rows (or transactions) that don't appear in both sheets onto a third sheet.

The data in each row must match exactly in both sheets.

Thoughts?

Thanks!

 

[ColinKJ]

Hi piper6,

This should do it:

Sub CopyIfNoMatch()
R = Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
For a = 1 To R
    RR = Sheets(2).Range("A" & Rows.Count).End(xlUp).Row
    For aa = 1 To RR
        If Sheets(1).Cells(a, 1) = Sheets(2).Cells(aa, 1) Then
            For col = 2 To 12
                If Sheets(1).Cells(a, col) <> Sheets(2).Cells(aa, col) Then GoTo nextaa
            Next col
            'We have a unique record
            RRR = Sheets(3).Range("A" & Rows.Count).End(xlUp).Row + 1
           Sheets(1).Range("A" & a & ":L" & a).Copy Sheets(3).Range("A" & RRR & ":L" & RRR)
        End If
nextaa:
    Next aa
Next a
R = Sheets(2).Range("A" & Rows.Count).End(xlUp).Row
For a = 1 To R
    RR = Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
    For aa = 1 To RR
        If Sheets(2).Cells(a, 1) = Sheets(1).Cells(aa, 1) Then
            For col = 2 To 12
                If Sheets(2).Cells(a, col) <> Sheets(1).Cells(aa, col) Then GoTo nextaa1
            Next col
            'We have a unique record
            RRR = Sheets(3).Range("A" & Rows.Count).End(xlUp).Row + 1
           Sheets(2).Range("A" & a & ":L" & a).Copy Sheets(3).Range("A" & RRR & ":L" & RRR)
        End If
nextaa1:
    Next aa
Next a
End Sub

I've also put together an example WB named CopyIfNoMatch.xls which you can download from:

http://www.box.net/shared/ccmckj4ipo

Press Ctrl+q, and any records on sheet1 and not on sheet2 are copied to sheet 3, likewise, any records on sheet2 not on sheet1 are copied to sheet3.

ColinKJ

 

[piper6]

Hi ColinKJ,

I downloaded the example workbook and when pressing Ctrl-Q or running the Macro, the result was 6 entires pasted in Sheet3; 3 of them being unique and 3 duplicates. It seems it pasted twice the 3 unique entires that appear in both sheets.

1 VWTOU32 001 Feb-88 Jan-06 Touareg 3.2 02/03-01/06 Engine 241Bhp VWTOU_32A
1 VWTOU33 001 Jan-00 Jan-00 Touareg 3.3 07/10- VWTOU_33A
1 VWTOU36 001 Jan-91 Dec-99 Touareg 3.6 04/06-03/11 Engine 276Bhp VWTOU_36A
1 VWTOU32 001 Feb-88 Jan-06 Touareg 3.2 02/03-01/06 Engine 241Bhp VWTOU_32A
1 VWTOU33 001 Jan-00 Jan-00 Touareg 3.3 07/10- VWTOU_33A
1 VWTOU36 001 Jan-91 Dec-99 Touareg 3.6 04/06-03/11 Engine 276Bhp VWTOU_36A

thoughts?

 

[ColinKJ]

Hi piper6,

Sorry about that, I thought just after I sent it I hadn't quite got the logic right.

I'll have another look in a while and get back to you.

ColinKJ

 

[ColinKJ]

Hi piper6,

The following code should now do it:

Sub CopyIfNoMatch()
'First Compare Sheet1 Entries with Sheet2
R = Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
RR = Sheets(2).Range("A" & Rows.Count).End(xlUp).Row
For a = 1 To R
   
    q = Sheets(1).Cells(a, 1): c = 0
    On Error Resume Next
    c = Sheets(2).Range("A1:A" & RR).Find(What:=q, LookIn:=xlValues).Row
    On Error GoTo 0
    If c <> 0 Then GoTo nexta
'This Sheet1 record doesn't exist on Sheet2 so copy to Sheet3
RRR = Sheets(3).Range("A" & Rows.Count).End(xlUp).Row + 1
Sheets(1).Range("A" & a & ":L" & a).Copy Sheets(3).Range("A" & RRR & ":L" & RRR)
nexta:
Next a
'Now Compare Sheet2 Entries with Sheet1
R = Sheets(2).Range("A" & Rows.Count).End(xlUp).Row
RR = Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
For a = 1 To R
    q = Sheets(2).Cells(a, 1): c = 0
    On Error Resume Next
    c = Sheets(1).Range("A1:A" & RR).Find(What:=q, LookIn:=xlValues).Row
    On Error GoTo 0
    If c <> 0 Then GoTo nexta1
            'This Sheet2 record doesn't exist on Sheet1 so copy to Sheet3
            RRR = Sheets(3).Range("A" & Rows.Count).End(xlUp).Row + 1
           Sheets(2).Range("A" & a & ":L" & a).Copy Sheets(3).Range("A" & RRR & ":L" & RRR)
nexta1:
Next a
Sheets(3).Activate
End Sub

You can also download the revised version CopyIfNoMatch.xls from:

http://www.box.net/shared/iut6l4buys

You'll see on sheets 1 & 2, those records coloured which aren't on the other sheet.

You need to be aware that this works on column A, so, if the record field A from Sheet1 isn't in any of the record fields A on Sheet2, then the record is copied to Sheet3, and likewise for Sheet2 to Sheet1.

Now I don't know how unique the record needs to be for your application, as for instance, you could have a record on Sheet1 Column A with "Data1", and 2 records on Sheet2 say with "Data1" in column A, but one of these could have some different data in some of the other fields. In the above code, because Data1 exists in Column A on Sheet2, the record would not be copied to Sheet3.

Regards

ColinKJ

In the above

 

[piper6]

Thanks for that. Works great.

Is there an 'easy' way to check all columns to ensure the entire record is identical instead of just column A?
So for the first record (row), it would compare the data in that row, (columns A through L) with sheet2 and look for an exact match.

 

[ColinKJ]

Hi piper6,

This code checks all fields in a records to determine a duplicate record.

Sub CheckAllFields()
R = Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
RR = Sheets(2).Range("A" & Rows.Count).End(xlUp).Row
For s1 = 1 To R
    For s2 = 1 To RR
        For col = 1 To 12
            If Sheets(1).Cells(s1, col) <> Sheets(2).Cells(s2, col) Then GoTo nexts2
        Next col
        'It must be a duplicate
        GoTo nexts1
nexts2:
    Next s2
'This Sheet1 record doesn't exist on Sheet2 so copy to Sheet3
RRR = Sheets(3).Range("A" & Rows.Count).End(xlUp).Row + 1
Sheets(1).Range("A" & s1 & ":L" & s1).Copy Sheets(3).Range("A" & RRR & ":L" & RRR)
nexts1:
Next s1
 
R = Sheets(2).Range("A" & Rows.Count).End(xlUp).Row
RR = Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
For s2 = 1 To R
    For s1 = 1 To RR
        For col = 1 To 12
            If Sheets(1).Cells(s1, col) <> Sheets(2).Cells(s2, col) Then GoTo nexts22
        Next col
        'It must be a duplicate
        GoTo nexts11
nexts22:
    Next s1
'This Sheet2 record doesn't exist on Sheet1 so copy to Sheet3
RRR = Sheets(3).Range("A" & Rows.Count).End(xlUp).Row + 1
Sheets(2).Range("A" & s2 & ":L" & s2).Copy Sheets(3).Range("A" & RRR & ":L" & RRR)
nexts11:
Next s2
End Sub

ColinKJ

 

[piper6]

Brilliant. Works like a dream.
Thanks so much for your help on this one.

Stefan