comparing lists in 2 workbooks and de-duplicating

G

Guest

I have 2 workbooks each containing long lists of names and addresses.

I need to compare the surname in column B and the first line of the address
in column D of workbook 1 with the list in workbook 2 (columns C and D). If
the same info occurs in workbook 2 I want to delete the entire line from that
list.

Can you help please?
 
G

Guest

Alan, I'm not sure I understand exactly what you're after but this should
give you a good start:
Sub DeleteDups()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim r1 As Range
Dim r2 As Range
Dim r3 As Range
Dim lRow1 As Long
Dim lRow2 As Long
Dim FirstAddress As String
Set ws1 = Workbooks("YourBook1.xls").Worksheets("Yoursheet")
Set ws2 = Workbooks("YourBook2.xls").Worksheets("Yoursheet")
lRow1 = ws1.Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
Set r1 = ws1.Range("B1:B" & lRow1)
lRow2 = ws2.Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
Set r2 = ws2.Range("C1:C" & lRow2)
For cnt = lRow2 To 1 Step -1
Set r3 = Nothing
FirstAddress = ""
Set r1 = ws1.Range("B" & cnt)
Set r3 = r2.Find(What:=r1, SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, LookAt:=xlWhole, MatchCase:=False)
If r3 Is Nothing Then GoTo NextCnt
If r3.Offset(, 1) = r1.Offset(, 2) Then
r1.EntireRow.Delete
Else
FirstAddress = r3.Address
Do
Set r3 = r2.FindNext
If r3.Offset(, 1) = r1.Offset(, 2) Then
r1.EntireRow.Delete
Exit Do
End If
Loop Until r3.Address = FirstAddress
End If
NextCnt:
Next
End Sub
 

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