Excel delete duplicate rows

Closed
bob foster - Jun 7, 2010 at 11:33 PM
rizvisa1 Posts 4478 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 - Jun 8, 2010 at 05:20 AM
trying to delete all rows that are the same leaving in the excel only the rows that are unique

ex:

heading 1 heading 2 heading 3
bob foster jr
robert smith III
jame spalding sr
bob foster jr


I would like to take that example and have it show as

heading 1 heading 2 heading 3
robert smith III
jame spalding sr


remove the rows that are the same leaving the one's that are unique.

thanks in advance.

1 response

rizvisa1 Posts 4478 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 766
Jun 8, 2010 at 05:20 AM
Sub DeleteDuplicate()
Dim iMaxCols As Integer
Dim lMaxRows As Long
Dim Cell As Range

    ActiveSheet.AutoFilterMode = False
    
    Set Cell = Cells.Find("*", Cells(1, "A"), SearchOrder:=xlByColumns, SearchDirection:=xlPrevious)
    
    If Cell Is Nothing Then Exit Sub
    
    iMaxCols = Cell.Column + 1
    
    Set Cell = Cells.Find("*", Cells(1, 1), SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
    
    lMaxRows = Cell.Row
    
    With Range(Cells(1, iMaxCols), Cells(lMaxRows, iMaxCols))
        .FormulaR1C1 = "= RC1 & ""|"" & RC2 & ""|"" & RC3"
        .Copy
        .PasteSpecial xlPasteValues
    End With
    
    With Range(Cells(1, iMaxCols + 1), Cells(lMaxRows, iMaxCols + 1))
        .FormulaR1C1 = "=COUNTIF( R1C[-1] : RC[-1],""="" & RC[-1])"
        .Copy
        .PasteSpecial xlPasteValues
    End With
    
    Cells.Select
    Selection.AutoFilter
    
    Cells.AutoFilter Field:=iMaxCols + 1, Criteria1:=">1"
    
    Rows("2:" & lMaxRows).Delete
    
    ActiveSheet.AutoFilterMode = False
    Columns(iMaxCols).Delete
    Columns(iMaxCols).Delete
    
    Set Cell = noting
    
End Sub
0