Removing duplicate entries

K

katiek648

My company just purchased an email list that has numberous duplicate emails.
It looks something like this:

First Name Last Name Email
Thomas Gordon [email protected]
William Hughes [email protected]
Robert Doby [email protected]
Carter Burdette [email protected]
Claudia Coscia [email protected]
Christine Holland [email protected]
Joel Hayhurst [email protected]
Krista Bates [email protected]
William Hayward [email protected]
D Wade Cloud [email protected]
John Sonderegger [email protected]

We would like to remove all duplicate emails except for the first occuring
one so that it would look like this:

First Name Last Name Email
Thomas Gordon [email protected]
William Hughes
Robert Doby
Carter Burdette
Claudia Coscia
Christine Holland
Joel Hayhurst [email protected]
Krista Bates
William Hayward
D Wade Cloud
John Sonderegger [email protected]


Is there some way to set up a filter to do this automatically? Thanks for
your help in advance!!
 
P

PCLIVE

Sub test()
' This function must sort first.
'This assumes the name and email address are in column A and B
Range("A1:" & (Range("B65536").End(xlUp).Address)).Select
Selection.Sort Key1:=Range("B1"), Order1:=xlAscending, _
Header:=xlNo, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom
ColNum = Selection(2).Column
For RowNdx = Selection(Selection.Cells.Count).Row To _
Selection(2).Row + 1 Step -1
If Cells(RowNdx, ColNum).Value = Cells(RowNdx - 1, ColNum).Value
Then
Range("B" & RowNdx).ClearContents
'Cells (RowNdx, ColNum).Value = ""
End If
Next RowNdx


End Sub
 
Top