Deleting duplicate rows

[orlandomike]

I know this has to have been asked 1000 times but here goes another.

I know you can use advanced filtering to delte duplicate rows but they will only be seen as duplicate if all the columns in each row is the same.

I want to take a table of several columns, sort it off of one of those columns, for example client name, Any time the clients name is duplicated, all rows containing that name will be deleted. (except one of course.)

example:

Smith South Street Florida
Jones North Street Florida
Smith South St. Florida

Under advanced filtering the extra smith row wouldnt be deleted as it isnt an exact match. I want to delete that row.

Thanks.

 

[jindon]

Hi
try the code

Sub del_allDup()
Dim r As Range, a() As String, rng As Range, str As String, i As Long
Set rng = Range("a1", Range("a65536").End(xlUp))
    i = 0
    For Each r In rng
        If Not IsEmpty(r) And Application.CountIf(rng, r) > 1 Then
            i = i + 1
            ReDim Preserve a(1 To i)
            a(i) = r.Address(0, 0)
        End If
    Next
    str = Join(a, ",")
    If str <> "" Then
        Range(str).EntireRow.Delete
    End If
Erase a
End Sub[code]
hope this helps
jindon

oops! Don't use this code! this will delete all duplicates include original record. I misread your problem.  Sorry.

[code]
Sub del_allDup()
Dim a() As String, rng As Range, str As String, i As Long
Set rng = Range("a1", Range("a65536").End(xlUp))
start:
    For Each r In rng
        If Application.CountIf(Range("a1:a" & r.Row), r) > 1 Then
            i = i + 1
            ReDim Preserve a(1 To i)
            a(i) = r.Address(0, 0)
            If i = 50 Then
                str = Join(a, ",")
                Range(str).EntireRow.Delete
                i = 0
                Erase a
                GoTo start
            End If
        End If
    Next
    str = Join(a, ",")
    If str <> "" Then
        Range(str).EntireRow.Delete
    End If
Erase a
End Sub
[code]

edited:

 

[tactps]

Welcome
Advanced Filtering:
Highlight the column that contains the names only, before you use the advanced filter.

Another solution:
VBA:
Sub SeekAndDestroy()

Cells.Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Do Until ActiveCell.Text = ""
If ActiveCell.Text = ActiveCell.Offset(1, 0).Text Then
ActiveCell.EntireRow.Delete
Else
ActiveCell.Offset(1, 0).Select
End If
Loop
End Sub