Wednesday, 19 October 2011

Macro to remove duplicates in an excel sheet and retain the latest or the last entry

Hi All,
The below macro will delete the duplicate entry in an excel sheet and it will only retain the latest or last entry made


Sub deleteDuplicate(Book2 As String)
   
    Dim cRow As Integer
    Dim cRow2 As Integer
    Dim MNOT As Integer
   
    Dim cCol As Integer
    Dim foundDuplicate As Boolean
 For MNOT = 1 To 500
    cRow = 2
    Do While IsEmpty(Worksheets(Book2).Cells(cRow, 1)) = False
        cRow2 = cRow + 1
        Do While IsEmpty(Worksheets(Book2).Cells(cRow2, 1)) = False
            foundDuplicate = True
            For cCol = 1 To 4
                If Worksheets(Book2).Cells(cRow, cCol).Value <> Worksheets(Book2).Cells(cRow2, cCol).Value Then
                    foundDuplicate = False
                    Exit For
                End If
            Next
            If foundDuplicate = True Then
                Worksheets(Book2).Rows(cRow).Delete xlShiftUp
            Else
                cRow2 = cRow2 + 1
            End If
        Loop
        cRow = cRow + 1
    Loop
 Next
End Sub
Sub test()
    deleteDuplicate "Sheet1"
End Sub











No comments:

Post a Comment