Remove rows without Duplicates

**Apple1** · 05-27-2013, 06:01 AM

Using Excel 2007

2 columns: Project Name & Address

Many rows

For these rows, some of the address are duplicates.

I want to remove the rows that don't have duplicate addresses.

Thank you

**MickG** · 05-27-2013, 06:44 AM

Try this:-

Sub MG27May07
Dim Rng         As Range
Dim Dn          As Range
Dim n           As Long
Set Rng = Range(Range("B2"), Range("B" & Rows.Count).End(xlUp))
For n = Rng.Count + 1 To 1 Step -1
    With Range("B" & n)
        If Application.CountIf(Rng, .Value) = 1 Then .EntireRow.Delete
    End With
Next n
End Sub

Regards Mick

**Apple1** · 05-27-2013, 09:14 PM

Hi Mick

The macros work well. How do I learn how to create macros?

For a start, can you explain the code of this macro?

Thank you

**MickG** · 05-28-2013, 10:12 AM

You need to buy some Basic books, try looking at top of Page for threads relating to Starting in VBA.
I have added comments to the code below:_

Sub MG28May52
'Use "Dim" statements to set Variables
Dim Rng         As Range
Dim Dn          As Range
Dim n           As Long
'Set range Variable "Rng" to From "B!" to last Row with data in column "B".
Set Rng = Range(Range("B2"), Range("B" & Rows.Count).End(xlUp))

'Loop through Rows in column "B", from bottom to top.
    'NB:- If you loop from top to bottom when deleting cells, then
    'the act of deleting cells will alter the loop selection and you wiull miss cells.
For n = Rng.Count + 1 To 1 Step -1
   
   'Use Worksheet formuls "Countif" to count duplicates
   ' If ans is "1" then delete row
    With Range("B" & n)
       'Use "With" statement to reduce size of code
        If Application.CountIf(Rng, .Value) = 1 Then .EntireRow.Delete
    End With
Next n
End Sub