Finding duplicate data quickly in a row?

**lesliepear** · 12-05-2009, 08:55 PM

I have a spreadsheet with 1500 e-mails in a column - what is a quick way I can find duplicate e-mails in my column to delete the duplicate data?

Thanks

**shg** · 12-05-2009, 08:58 PM

In an adjacent column, =if(countif(A$1:A1, A1)>1 "Dup", "")

**darkyam** · 12-05-2009, 09:00 PM

Or you could use advanced filter and have it either shorten the list to unique values in place or copy the unique values to another range.

**teylyn** · 12-05-2009, 09:01 PM

darkyam, XL 2000 doesn't do unique filtering. That's new with 2007

**shg** · 12-05-2009, 09:03 PM

I think Advanced Filter always supported unique filtering, T.

**solnajeff** · 12-05-2009, 09:04 PM

HI

Providing the cell contents are identical then the following code should be okay.

Sub rem_dup()

Dim a As Integer

Application.ScreenUpdating = False

For a = 1500 To 1 Step -1

If Application.CountIf(Range("A1:A1500"), Cells(a, 1).Value) > 1 And Cells(a, 1).Value <> "" Then
Cells(a, 1).Delete Shift:=xlUp
End If

Next a

Application.ScreenUpdating = True

End Sub

Regards

Jeff

**teylyn** · 12-05-2009, 09:07 PM

time to polish my contacts ... was reading autofilter instead of advanced filter ....

**pike** · 12-05-2009, 09:50 PM

or maybe

Option Explicit
Sub ptest()
    Dim p!, i!, k(), e
    With Range("a2", Range("a" & Rows.Count).End(xlUp)).Resize(, 1)
        e = .Value
    End With
    ReDim k(1 To UBound(e, 1), 1)
    With CreateObject("Scripting.Dictionary")
        .CompareMode = vbTextCompare
        For i = 1 To UBound(e, 1)
            If Not IsEmpty(e(i, 1)) Then
                If Not .exists(e(i, 1)) Then
                    p = p + 1
                  k(p, 0) = e(i, 1)
                  .Add e(i, 1), p
                  End If
         End If
        Next
       With Range("a2", Range("a" & Rows.Count).End(xlUp)).Resize(, 1)
        .ClearContents
    End With
       End With
    Range("a1").Resize(p, 1).Value = k
 End Sub