Delete duplicate records using VBA in Microsoft Excel

In this article, we will create a macro to remove duplicate records from the data.

Raw data consists of employee data, which includes Name, Age and Gender.

ArrowMain

Logic explanation

We have created a macro “RemovingDuplicate” to remove duplicate records from the data. This macro firstly sources the data in a sequence and then makes comparison between values of two consecutive rows to find out duplicate records.

ArrowOutput

Code explanation

ActiveSheet.Sort.SortFields.Clear

The above code is used to remove any previous sorting on the data.

ActiveSheet.Sort.SortFields.Add Key:=Range(Selection.Address), _

SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers

The above code is used to sort the data in the first column in ascending order.

For i = ActiveSheet.Cells(Rows.Count, Selection.Column).End(xlUp).Row To Selection.Row + 1 Step -1

The above code is used to apply reverse looping, starting from last row to the selected row.

ActiveSheet.Rows(i).Delete shift:=xlUp

The above code is used to delete a row and move cursor to the upper row.

Please follow below for the code


Option Explicit

Sub RemovingDuplicate()

'Declaring variables
Dim i  As Long

'Disabling screen updates
Application.ScreenUpdating = False

Range("A11").Select

ActiveSheet.Sort.SortFields.Clear

'Sorting data in ascending order
ActiveSheet.Sort.SortFields.Add Key:=Range(Selection.Address), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers

With ActiveSheet.Sort
    .SetRange Range(Selection.Offset(1, 0), ActiveSheet.Cells(Rows.Count, Selection.End(xlToRight).Column).End(xlUp))
    .Header = xlNo
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

'Looping through all the cells
For i = ActiveSheet.Cells(Rows.Count, Selection.Column).End(xlUp).Row To Selection.Row + 1 Step -1
    
    'Comparing value of two adjacent cells for duplicate records
    If ActiveSheet.Cells(i, Selection.Column).Value = ActiveSheet.Cells((i - 1), Selection.Column).Value Then
        
        'Delete the duplicate record
        ActiveSheet.Rows(i).Delete shift:=xlUp
    End If
    
Next i

'Enabling screen updates
Application.ScreenUpdating = True

End Sub

If you liked this blog, share it with your friends on Facebook. Also, you can follow us on Twitter and Facebook.

We would love to hear from you, do let us know how we can improve our work and make it better for you. Write to us at info@exceltip.com