Monday, November 24, 2008

Delete Duplicate Rows in Excel

This code works very nice which deletes the duplicate rows in given set of data.

Sub DelDups() 

' Deletes duplicate rows in the selected range. 
' All columns in the selected range must be identical for 
' a row to be deleted. The entire row, not just the selected 
' cells in the row, will be deleted if a duplicate is found. 
' The first instance of the duplicate row is the copy that 
' will be retained. 

  Dim iRow As Long 
  Dim jRow As Long 
  Dim iCol As Integer 
  Dim LastRow As Long 'The last row in the selected range 
  Dim FirstRow As Long 'The first row in the selected range 
  Dim FirstCol As Integer 
  Dim LastCol As Integer 
  Dim DelCount As Long 'The count of duplicate rows removed 
  Dim DupFound As Boolean 'True if duplicate row found 
   
  DelCount = 0 
   
  FirstRow = Selection.Row 
  LastRow = FirstRow + Selection.Rows.Count - 1 
  FirstCol = Selection.Column 
  LastCol = FirstCol + Selection.Columns.Count - 1 
   
  For iRow = FirstRow To LastRow - 1 
   
  For jRow = iRow + 1 To LastRow 
   
  DupFound = True 
  For iCol = FirstCol To LastCol 
  DupFound = DupFound And (Cells(jRow, iCol) = Cells(iRow, iCol)) 
  If Not DupFound Then Exit For 
  Next iCol 
  If DupFound Then 
  ' Duplicate row found--delete it 
  Rows(jRow).Delete 
  LastRow = LastRow - 1 
  DelCount = DelCount + 1 
  End If 
   
  Next jRow 
   
  Next iRow 
   
  Beep 
  MsgBox DelCount & " duplicate rows deleted.", _ 
  vbInformation, "Duplicate Removal Results" 

End Sub 


No comments: