Lookup duplicates and Delete Rows

LJREdinburgh

New Member
Joined
May 20, 2014
Messages
46
Hi,

I have a database #1 of contact information consisting of e-mails, first name, last name, business name, etc. which contains many entries (rows) that need to be deleted. These entries would be deleted based on a secondary database #2 consisting of just e-mails.

If there are duplicates in the E-mails (both database column A) than those rows from database #1 should be deleted.

Is there an easy way to set this up? Or would it be easier to manually go through and delete duplicates? There are roughly 1000, hence why I am trying to find a quicker way.

Thanks
 

Some videos you may like

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
38,761
Office Version
365
Platform
Windows
Hiya
If the e-mail addresses as in EXACTLY the same format in both books, then this is pretty simple to do with VBA. If you can let me know the following I'll set something up.
a) The name of workbook #1 along with the sheet name
b) The name of workbook #2 along with the sheet name
c) Are there any blanks in Column A, in either workbook?
 

LJREdinburgh

New Member
Joined
May 20, 2014
Messages
46
Hiya
If the e-mail addresses as in EXACTLY the same format in both books, then this is pretty simple to do with VBA. If you can let me know the following I'll set something up.
a) The name of workbook #1 along with the sheet name
b) The name of workbook #2 along with the sheet name
c) Are there any blanks in Column A, in either workbook?
I am glad that you say this is pretty simple! It will save me a bit of legwork

A) Tidied Database , Sheet1
B) Bounces , Sheet1
C) No blanks in Column A, Data begins from cell A2 each time. Is usually a full e-mail address, but somtimes might not have @ symbol.

Thanks!
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
38,761
Office Version
365
Platform
Windows
Ok
Give this a go, put it in a standard module, in either workbook & ensure both books are open before you run it.

Code:
Sub E_Mail()

    Dim Dict As Scripting.Dictionary
    Dim ValU As Variant
    Dim Adds As Variant
    Dim DbSht As Worksheet
    Dim BoSht As Worksheet
    Dim UsdRws As Long
    Dim i As Long

With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With

    Set DbSht = Workbooks("Tidied Database.[COLOR=#ff0000]xls[/COLOR]").Sheets("Sheet1")
    Set BoSht = Workbooks("Bounces.[COLOR=#ff0000]xls[/COLOR]").Sheets("Sheet1")

    With BoSht
        Adds = .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
    End With

    Set Dict = CreateObject("Scripting.Dictionary")
    With Dict
        For Each ValU In Adds
            If Not IsEmpty(ValU) Then
                If Not .Exists(ValU) Then .Add (ValU), Nothing
            End If
        Next ValU
    End With

    With DbSht
        UsdRws = .Range("A" & .Rows.Count).End(xlUp).Row
        For i = UsdRws To 2 Step -1
            If Dict.Exists(.Range("A" & i).Value) Then .Rows(i).Delete
        Next i
    End With

With Application
    .ScreenUpdating = True
    .EnableEvents = True
End With

End Sub
You'll probably need to change the file extensions to suit.
 

LJREdinburgh

New Member
Joined
May 20, 2014
Messages
46
Ok
Give this a go, put it in a standard module, in either workbook & ensure both books are open before you run it.

Code:
Sub E_Mail()

    Dim Dict As Scripting.Dictionary
    Dim ValU As Variant
    Dim Adds As Variant
    Dim DbSht As Worksheet
    Dim BoSht As Worksheet
    Dim UsdRws As Long
    Dim i As Long

With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With

    Set DbSht = Workbooks("Tidied Database.[COLOR=#ff0000]xls[/COLOR]").Sheets("Sheet1")
    Set BoSht = Workbooks("Bounces.[COLOR=#ff0000]xls[/COLOR]").Sheets("Sheet1")

    With BoSht
        Adds = .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
    End With

    Set Dict = CreateObject("Scripting.Dictionary")
    With Dict
        For Each ValU In Adds
            If Not IsEmpty(ValU) Then
                If Not .Exists(ValU) Then .Add (ValU), Nothing
            End If
        Next ValU
    End With

    With DbSht
        UsdRws = .Range("A" & .Rows.Count).End(xlUp).Row
        For i = UsdRws To 2 Step -1
            If Dict.Exists(.Range("A" & i).Value) Then .Rows(i).Delete
        Next i
    End With

With Application
    .ScreenUpdating = True
    .EnableEvents = True
End With

End Sub
You'll probably need to change the file extensions to suit.
Received a Compile error: User-defined type not defined and the first line is highlighted i.e. Dim Dict As Scripting.Dictionary
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
38,761
Office Version
365
Platform
Windows
:banghead:
One day I'll B... remember to put this into the post
In the VB editor select Tools > References > Microsoft Scripting Runtime making sure that the checkbox is ticked, rather than the line just highlighted.
Sorry about that
 

LJREdinburgh

New Member
Joined
May 20, 2014
Messages
46
:banghead:
One day I'll B... remember to put this into the post
In the VB editor select Tools > References > Microsoft Scripting Runtime making sure that the checkbox is ticked, rather than the line just highlighted.
Sorry about that

Had to make a few tweaks here and there in the file path's but it has worked great!

Thanks again!
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
38,761
Office Version
365
Platform
Windows
(y)
Thanks for the feedback
Glad to be able to help
 

Watch MrExcel Video

Forum statistics

Threads
1,095,750
Messages
5,446,271
Members
405,393
Latest member
sully361

This Week's Hot Topics

Top