Delete Duplicate Rows.

[donlincolnmre2]

Hello

I have a worksheet with two columns: Address and City. Column A contains duplicate data all over, i'm looking for a macro that will look in column A and if it finds DUPLICATE then it should DELETE BOTH DUPLICATE ROWS.

As you can see from the sample data below, BOT ROWS for address " 1181 CAMEO DR " should be deleted and same for
" 12996 VIALATINA "

Any help would be greatly appreciated.

Thanks.


Sample date.
----------------

1011 E SAINT GERTRUDE PL
10243 STONE POINT LN
1063 E ANGELENO AVE
1181 CAMEO DR
1181 CAMEO DR
11846 ORCHARD AVE
11862 MEAJEAN PL
12996 VIALATINA
12996 VIALATINA
13023 W SUNSET BLVD
131 MOUNTVIEW TER

 

[Michael M]

IS the data sorted ??

 

[Michael M]

Maybe this IF the data is sorted

Sub MM1()
Dim lr As Long, r As Long
lr = Cells(Rows.Count, "A").End(xlUp).Row
For r = lr To 2 Step -1
    If Range("A" & r).Value = Range("A" & r - 1).Value Then
        Rows(r & ":" & r - 1).Delete
    End If
Next r
End Sub

 

[donlincolnmre2]

IS the data sorted ??

Hello Michael

That worked great. Thanks a lot.

 

[alansidman]

An alternative if the data is not sorted:

Sub DeleteDuplicateRows()
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' DeleteDuplicateRows
' This will delete duplicate records, based on the Active Column. That is,
' if the same value is found more than once in the Active Column, all but
' the first (lowest row number) will be deleted.
'
' To run the macro, select the entire column you wish to scan for
' duplicates, and run this procedure.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


    Dim r As Long
    Dim n As Long
    Dim v As Variant
    Dim rng As Range


    On Error GoTo EndMacro
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual




    Set rng = Application.Intersect(ActiveSheet.UsedRange, _
                                    ActiveSheet.Columns(ActiveCell.Column))


    Application.StatusBar = "Processing Row: " & Format(rng.Row, "#,##0")


    n = 0
    For r = rng.Rows.Count To 2 Step -1
        If r Mod 500 = 0 Then
            Application.StatusBar = "Processing Row: " & Format(r, "#,##0")
        End If


        v = rng.Cells(r, 1).Value
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        ' Note that COUNTIF works oddly with a Variant that is equal to vbNullString.
        ' Rather than pass in the variant, you need to pass in vbNullString explicitly.
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        If v = vbNullString Then
            If Application.WorksheetFunction.CountIf(rng.Columns(1), vbNullString) > 1 Then
                rng.Rows(r).EntireRow.Delete
                'rng.Rows(r).EntireRow.Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row + 1
                n = n + 1
            End If
        Else
            If Application.WorksheetFunction.CountIf(rng.Columns(1), v) > 1 Then
                rng.Rows(r).EntireRow.Delete
                'rng.Rows(r).EntireRow.Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row + 1
                n = n + 1
            End If
        End If
    Next r


EndMacro:


    Application.StatusBar = False
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    MsgBox "Duplicate Rows Deleted: " & CStr(n)




End Sub

 

[Michael M]

Pleasure...