Delete rows with duplicate values in column A

Created - Sept, 2008 - bweir.com

This is a VBA for Microsoft Excel

I designed it to evaluate the data in column A and delete any rows that have duplicate values.

   - this is the code.

Sub deleteDuplicateRows()

'   ************************************************
'   This code looks for identical values in column
'   "A"of an excel spreadsheet and deletes all but
'   the first row.  Select the first cell that you
'   want to evaluate, then let it rip.  It will stop
'   when it hits a cell with no data.
'   ************************************************
'   Copyright 2008 - bweir.com
'   Free for non commercial use only.
'   ************************************************
'   Created by Brad Weir - www.bweir.com
'   ************************************************


'Do While ActiveCell.Row < 60                       'For Debugging only
Do While ActiveCell.Value <> ""                     'For live use, stop loop when cell has no value

r = ActiveCell.Row                                  'Captures active row number
A1 = "A" & r                                        'Sets first cell to compare, designed for row A
A2 = "A" & r + 1                                    'Sets second cell to compare, designed for row A
'MsgBox ("A1 = " & A1 & ", A2 = " & A2)

    A = Range(A1).Value                             'Returns value in first cell
    B = Range(A2).Value                             'Returns value in second cell
    
    If A = B Then                                   'if cell is equal to cell above
    Range(A2).Select                                'select the second cell
    r = ActiveCell.Row                              'returns row of second cell
    'MsgBox (A2)
    Rows(r).Delete                                  'delete the second row
    Range(A1).Select                                'select the row above to re-evaluate
    Else                                            'if cell is not equal to cell above
    'MsgBox ("not equal")
    Range(A2).Select                                'if A2 is a new value, select A2
    End If

Loop
End Sub