Compare two spreadsheets and eliminate duplicates

  • Thread starter Joe_Hunt via OfficeKB.com
  • Start date
J

Joe_Hunt via OfficeKB.com

I would imagine this is in here somewhere, but I haven't found it, and can't
get it to work on my own. I have two spreadsheets that I've put in the same
workbook. I want to be able to eliminate the duplicates from the first
spreadsheet and make the output into a separate worksheet in the same
workbook. The data I'm comparing are in column B on the first worksheet and
can go to several thousand rows, and column A on the second that can go to
maybe 20,000 rows or so. I really appreciate your help. I could do it in
Access, but if a simple VBA solution is available this would be faster since
I'd need to put it back into Excel anyway. Thanks again.
 
J

JLGWhiz

You objective is not clear.

1. Do you have duplicates in Column B of worksheet 1?
2. Do you have duplicates in Column A of worksheet 2?
3. If yes to 1 & 2 above, do you want to delete the entire row for each
duplicate found?
4. Assuming you mean by "output" that you want the duplicate items recorded
on a third worksheet, do you want the entrie row for each item or just the
data from the duplicate cell of column B or A respectively?
5. Is Sheet3 in the workbook empty or will a new sheet be needed as the
third sheet in this exercise?
 
J

Joe_Hunt via OfficeKB.com

Sorry about that. Column B of worksheet 1 contains unique values, and Column
A of worksheet 2 contains unique values. I'm wanting to take worksheet 1,
delete any rows that have a match in worksheet 2, and put it into a new
worksheet in the same workbook. The worksheet will have to be added. Below is
what I have, and it works but is taking a very long time. The number of rows
vary, so I put in what would probably be the max number for each worksheet. I
realize there's a way to make it go to the last row of data, but I can't get
that to work. I appreciate your help.

Sub VINComparison()

Application.ScreenUpdating = False

Sheets("Mine").Select
Sheets("Mine").Copy After:=Sheets(2)
Sheets("Mine (2)").Select
Sheets("Mine (2)").Name = "New"
Range("A1").Select
Sheets("Ford").Select
Range("A1:G20000").Select
ActiveWorkbook.Names.Add Name:="FORD", RefersToR1C1:="=Ford!R1C1:
R20000C7"
Range("A1").Select
Sheets("New").Select
Range("J2").Select
ActiveCell.FormulaR1C1 = _
"=IF(VLOOKUP(RC[-8],FORD,1,FALSE)=TRUE,"" "",""Retain"")"
Range("J2").Select
Selection.AutoFill Destination:=Range("J2:J3500"), Type:=xlFillDefault

VinComparisonCleanup
End Sub

Sub VinComparisonCleanup()

Range("J2:J3500").Select
Selection.SpecialCells(xlCellTypeFormulas, 16).Select
Selection.EntireRow.Delete

Application.ScreenUpdating = True
End Sub

You objective is not clear.

1. Do you have duplicates in Column B of worksheet 1?
2. Do you have duplicates in Column A of worksheet 2?
3. If yes to 1 & 2 above, do you want to delete the entire row for each
duplicate found?
4. Assuming you mean by "output" that you want the duplicate items recorded
on a third worksheet, do you want the entrie row for each item or just the
data from the duplicate cell of column B or A respectively?
5. Is Sheet3 in the workbook empty or will a new sheet be needed as the
third sheet in this exercise?
I would imagine this is in here somewhere, but I haven't found it, and
can't
[quoted text clipped - 9 lines]
since
I'd need to put it back into Excel anyway. Thanks again.
 
J

JLGWhiz

I am still not clear on this issue:
4. Assuming you mean by "output" that you want the duplicate items
recorded
on a third worksheet, do you want the entrie row for each item or just the
data from the duplicate cell of column B or A respectively?

More specifically, what do you expect to see on the added sheet?

Nevertheless, the code below will do what I have interpreted your post to
call for. Post back for changes needed.

Sub Match_n_Scratch()
Dim lr1 As Long, sh1 As Worksheet, sh2 As Worksheet
Dim rng As Range, c As Range, lr2 As Long, f As Range
Set sh1 = Sheets("Sheet1") '<<<Change to actual
Set sh2 = Sheets("Sheet2") '<<<Change to actual
lr2 = sh2.Cells(Rows.Count, 1).End(xlUp).Row
lr1 = sh1.Cells(Rows.Count, 2).End(xlUp).Row
Set rng = sh2.Range("A2:A" & lr2)
Set newSh = Sheets.Add(After:=Sheets(Sheets.Count))
newSh.Name = "Dup_Dele"
For Each c In rng
Set f = sh1.Range("B2:B" & lr1).Find(c.Value, LookIn:=xlValues)
If Not f Is Nothing Then
f.EntireRow.Copy Sheets("Dup_Dele").Range("A" & _
Sheets("Dup_Dele").Cells(Rows.Count, 2).End(xlUp).Offset(1,
0).Row)
sh1.Rows(f.Row).Delete
End If
Next
End Sub



Joe_Hunt via OfficeKB.com said:
Sorry about that. Column B of worksheet 1 contains unique values, and
Column
A of worksheet 2 contains unique values. I'm wanting to take worksheet 1,
delete any rows that have a match in worksheet 2, and put it into a new
worksheet in the same workbook. The worksheet will have to be added. Below
is
what I have, and it works but is taking a very long time. The number of
rows
vary, so I put in what would probably be the max number for each
worksheet. I
realize there's a way to make it go to the last row of data, but I can't
get
that to work. I appreciate your help.

Sub VINComparison()

Application.ScreenUpdating = False

Sheets("Mine").Select
Sheets("Mine").Copy After:=Sheets(2)
Sheets("Mine (2)").Select
Sheets("Mine (2)").Name = "New"
Range("A1").Select
Sheets("Ford").Select
Range("A1:G20000").Select
ActiveWorkbook.Names.Add Name:="FORD", RefersToR1C1:="=Ford!R1C1:
R20000C7"
Range("A1").Select
Sheets("New").Select
Range("J2").Select
ActiveCell.FormulaR1C1 = _
"=IF(VLOOKUP(RC[-8],FORD,1,FALSE)=TRUE,"" "",""Retain"")"
Range("J2").Select
Selection.AutoFill Destination:=Range("J2:J3500"), Type:=xlFillDefault

VinComparisonCleanup
End Sub

Sub VinComparisonCleanup()

Range("J2:J3500").Select
Selection.SpecialCells(xlCellTypeFormulas, 16).Select
Selection.EntireRow.Delete

Application.ScreenUpdating = True
End Sub

You objective is not clear.

1. Do you have duplicates in Column B of worksheet 1?
2. Do you have duplicates in Column A of worksheet 2?
3. If yes to 1 & 2 above, do you want to delete the entire row for each
duplicate found?
4. Assuming you mean by "output" that you want the duplicate items
recorded
on a third worksheet, do you want the entrie row for each item or just the
data from the duplicate cell of column B or A respectively?
5. Is Sheet3 in the workbook empty or will a new sheet be needed as the
third sheet in this exercise?
I would imagine this is in here somewhere, but I haven't found it, and
can't
[quoted text clipped - 9 lines]
since
I'd need to put it back into Excel anyway. Thanks again.
 
J

Joe_Hunt via OfficeKB.com

I tried it and there was a syntax error on the section:

"f.EntireRow.Copy Sheets("Dup_Dele").Range("A" & _
Sheets("Dup_Dele").Cells(Rows.Count, 2).End(xlUp).Offset(1,
0).Row)"

Maybe another way to state it. Take worksheet 1 and anything in column B that
doesn't have a match on worksheet 2 column A, put the entire row on worksheet
3 (which needs to be added). Here's an example:

Worksheet 1-
Col A Col B Col C Col D
1 A Dog HJK
2 B Cat UHJ
3 C Ant POI
4 D Cow ERT

Worksheet 2
Col A Col B Col C Col D
V 5 olk Blue
T 6 5j1 Red
A 7 380 Grey
D 8 gkj Bald

In this example there are two matches between worksheet 1 column B and
worksheet 2 column A. I would want to have rows 2 and 3 from worksheet 1 on
the new worksheet in this case.


I am still not clear on this issue:
4. Assuming you mean by "output" that you want the duplicate items
recorded
on a third worksheet, do you want the entrie row for each item or just the
data from the duplicate cell of column B or A respectively?

More specifically, what do you expect to see on the added sheet?

Nevertheless, the code below will do what I have interpreted your post to
call for. Post back for changes needed.

Sub Match_n_Scratch()
Dim lr1 As Long, sh1 As Worksheet, sh2 As Worksheet
Dim rng As Range, c As Range, lr2 As Long, f As Range
Set sh1 = Sheets("Sheet1") '<<<Change to actual
Set sh2 = Sheets("Sheet2") '<<<Change to actual
lr2 = sh2.Cells(Rows.Count, 1).End(xlUp).Row
lr1 = sh1.Cells(Rows.Count, 2).End(xlUp).Row
Set rng = sh2.Range("A2:A" & lr2)
Set newSh = Sheets.Add(After:=Sheets(Sheets.Count))
newSh.Name = "Dup_Dele"
For Each c In rng
Set f = sh1.Range("B2:B" & lr1).Find(c.Value, LookIn:=xlValues)
If Not f Is Nothing Then
f.EntireRow.Copy Sheets("Dup_Dele").Range("A" & _
Sheets("Dup_Dele").Cells(Rows.Count, 2).End(xlUp).Offset(1,
0).Row)
sh1.Rows(f.Row).Delete
End If
Next
End Sub
Sorry about that. Column B of worksheet 1 contains unique values, and
Column
[quoted text clipped - 61 lines]
 
J

JLGWhiz

The code tests each cell in column A of sheet 2 for a match in column B of
sheet 1. If a match is found, it copies the entire row for the matched item
to the new sheet "Dup_Dele",and then deletes that row from sheet 1, based on
your statement that you wanted to delete duplicates from sheet 1.

The code displayed no errors when tested but line wrap in the news reader
often causes distorted results when pasting into a user's code window.

Sheets("Dup_Dele").Cells(Rows.Count, 2).End(xlUp).Offset(1,
0).Row)

This should all be on one line like:

Sheets("Dup_Dele").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Row)

Or you can use a line attenuation like:

Sheets("Dup_Dele").Cells(Rows.Count, 2) _
.End(xlUp).Offset(1, 0).Row)

to make it easier to read in one pane.

For clarity sake, see if you can get the code to run on you system first,
then tell me how you want to re-arrange the results of the code.

Joe_Hunt via OfficeKB.com said:
I tried it and there was a syntax error on the section:

"f.EntireRow.Copy Sheets("Dup_Dele").Range("A" & _
Sheets("Dup_Dele").Cells(Rows.Count, 2).End(xlUp).Offset(1,
0).Row)"

Maybe another way to state it. Take worksheet 1 and anything in column B
that
doesn't have a match on worksheet 2 column A, put the entire row on
worksheet
3 (which needs to be added). Here's an example:

Worksheet 1-
Col A Col B Col C Col D
1 A Dog HJK
2 B Cat UHJ
3 C Ant POI
4 D Cow ERT

Worksheet 2
Col A Col B Col C Col D
V 5 olk Blue
T 6 5j1 Red
A 7 380 Grey
D 8 gkj Bald

In this example there are two matches between worksheet 1 column B and
worksheet 2 column A. I would want to have rows 2 and 3 from worksheet 1
on
the new worksheet in this case.


I am still not clear on this issue:
4. Assuming you mean by "output" that you want the duplicate items
recorded
on a third worksheet, do you want the entrie row for each item or just
the
data from the duplicate cell of column B or A respectively?

More specifically, what do you expect to see on the added sheet?

Nevertheless, the code below will do what I have interpreted your post to
call for. Post back for changes needed.

Sub Match_n_Scratch()
Dim lr1 As Long, sh1 As Worksheet, sh2 As Worksheet
Dim rng As Range, c As Range, lr2 As Long, f As Range
Set sh1 = Sheets("Sheet1") '<<<Change to actual
Set sh2 = Sheets("Sheet2") '<<<Change to actual
lr2 = sh2.Cells(Rows.Count, 1).End(xlUp).Row
lr1 = sh1.Cells(Rows.Count, 2).End(xlUp).Row
Set rng = sh2.Range("A2:A" & lr2)
Set newSh = Sheets.Add(After:=Sheets(Sheets.Count))
newSh.Name = "Dup_Dele"
For Each c In rng
Set f = sh1.Range("B2:B" & lr1).Find(c.Value, LookIn:=xlValues)
If Not f Is Nothing Then
f.EntireRow.Copy Sheets("Dup_Dele").Range("A" & _
Sheets("Dup_Dele").Cells(Rows.Count, 2).End(xlUp).Offset(1,
0).Row)
sh1.Rows(f.Row).Delete
End If
Next
End Sub
Sorry about that. Column B of worksheet 1 contains unique values, and
Column
[quoted text clipped - 61 lines]
since
I'd need to put it back into Excel anyway. Thanks again.
 
J

Joe_Hunt via OfficeKB.com

That worked! Thanks a bunch. It wasn't exactly what I was looking for, but
it's actually better since I have a separate list of what the duplicates were
now. I really appreciate it.
The code tests each cell in column A of sheet 2 for a match in column B of
sheet 1. If a match is found, it copies the entire row for the matched item
to the new sheet "Dup_Dele",and then deletes that row from sheet 1, based on
your statement that you wanted to delete duplicates from sheet 1.

The code displayed no errors when tested but line wrap in the news reader
often causes distorted results when pasting into a user's code window.

Sheets("Dup_Dele").Cells(Rows.Count, 2).End(xlUp).Offset(1,
0).Row)

This should all be on one line like:

Sheets("Dup_Dele").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Row)

Or you can use a line attenuation like:

Sheets("Dup_Dele").Cells(Rows.Count, 2) _
.End(xlUp).Offset(1, 0).Row)

to make it easier to read in one pane.

For clarity sake, see if you can get the code to run on you system first,
then tell me how you want to re-arrange the results of the code.
I tried it and there was a syntax error on the section:
[quoted text clipped - 66 lines]
 
J

JLGWhiz

Happy to help.

JLGWhiz


Joe_Hunt via OfficeKB.com said:
That worked! Thanks a bunch. It wasn't exactly what I was looking for, but
it's actually better since I have a separate list of what the duplicates
were
now. I really appreciate it.
The code tests each cell in column A of sheet 2 for a match in column B of
sheet 1. If a match is found, it copies the entire row for the matched
item
to the new sheet "Dup_Dele",and then deletes that row from sheet 1, based
on
your statement that you wanted to delete duplicates from sheet 1.

The code displayed no errors when tested but line wrap in the news reader
often causes distorted results when pasting into a user's code window.

Sheets("Dup_Dele").Cells(Rows.Count, 2).End(xlUp).Offset(1,
0).Row)

This should all be on one line like:

Sheets("Dup_Dele").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Row)

Or you can use a line attenuation like:

Sheets("Dup_Dele").Cells(Rows.Count, 2) _
.End(xlUp).Offset(1, 0).Row)

to make it easier to read in one pane.

For clarity sake, see if you can get the code to run on you system first,
then tell me how you want to re-arrange the results of the code.
I tried it and there was a syntax error on the section:
[quoted text clipped - 66 lines]
since
I'd need to put it back into Excel anyway. Thanks again.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top