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:
Post a Comment