Home / User Contributed Macros / Delete Duplicate Rows

Delete Duplicate Rows

Select the column that contains duplicate entries and run the following macro.

  1. Public Sub DeleteDuplicateRows()

  3. Dim rowIndex,rowCount,columnIndex As Long
  4. Dim value As Variant
  5. Dim testRange As Range

  7. rowCount = ActiveSheet.UsedRange.Rows.count    
  8. columnIndex = ActiveCell.Column                                     'Column that contains duplicates

  10. Set testRange = Range(cells(1,columnIndex), cells(rowCount, columnIndex))

  12.     For rowIndex = rowCount To 2 Step -1                            'Iterating from bottom to retain first occurrence
  13.  
  14.         value = testRange.Cells(rowIndex, 1).Value
  15.  
  16.         If Application.WorksheetFunction.CountIf(testRange.Columns(1), value) > 1 Then
  17.             testRange.Rows(rowIndex).EntireRow.Delete          'deletes duplicate rows
  18.         End If
  19.  
  20.     Next rowIndex
  21.  
  22. End Sub


    		 RSS of this page