Resources

    All about Visual Basic for Application (VBA) especially for Microsoft Excel.

Subscribe

  • Subscribe

how to delete duplicate rows in excel using vba?

Posted by | July 12, 2011 .

How to delete or remove duplicate rows in excel using VBA? The answer depends on which is reference column, if we refer to column A and B then below code will work well.

Option Explicit
Sub Deleteduplicaterowsallsheet()
Dim a As Integer
Dim sht As Integer
Dim x As Long
Dim y As Long
Application.ScreenUpdating = False
sht = Sheets.Count
For a = 1 To sht
    Sheets(a).Select
    Cells.Select
    Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Key2:=Range("B1") _
        , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
        :=xlSortNormal
    x = 1 'Starting row
    y = x + 1
    Do While Cells(x, 1).Value <> ""
        Do While Cells(y, 1).Value <> ""
            If (Cells(x, 1).Value = Cells(y, 1).Value And _
            Cells(x, 2).Value = Cells(y, 2).Value) Then
            Cells(y, 1).EntireRow.Delete
            Else
                y = y + 1
            End If
        Loop
    x = x + 1
    y = x + 1
    Loop
    Range("A1").Select
Next
Sheets(1).Select
Application.ScreenUpdating = True
End Sub

The above code too long and difficult to understand, it will be easier to loop descending compare with ascending as below. The result will be the same.

Option Explicit
Sub deleteduplicaterowsallsheet2()
Dim a As Integer
Dim sht As Integer
Dim x As Long
Dim LstRow As Long
Application.ScreenUpdating = False
sht = Sheets.Count
For a = 1 To sht
    Sheets(a).Select
    Cells.Select
    Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Key2:=Range("B1") _
        , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
        :=xlSortNormal
    LstRow = ActiveCell.SpecialCells(xlCellTypeLastCell).Row
    For x = LstRow To 2 Step -1
        If (Cells(x, 1).Value = Cells(x - 1, 1).Value And _
            Cells(x, 2).Value = Cells(x - 1, 2).Value) Then
            Cells(x, 1).EntireRow.Delete
        End If
    Next
    Range("A1").Select
Next
Sheets(1).Select
Application.ScreenUpdating = True
End Sub

Both codes can remove or delete duplicate rows for column A and B. Please try and give your comment.



Share Button
Share on Facebook
Bookmark this on Digg
Bookmark this on Yahoo Bookmark
Bookmark this on Google Bookmarks
Bookmark this on Delicious

Leave a Comment

If you would like to make a comment, please fill out the form below.

Name (required)

Email (required)

Website

Comments

1 Comment so far
  1. vicktor schausberger August 27, 2012 3:19 pm

    I need to hire a programmer, but he/she has to live in orlando, my project is so difficult to explain, has to be in person, only orlando florida area.