Excel VBA - Removing duplicates

Question

I try to sort a sheet in my workbook. After the macro sorted my table it should remove all duplicates based on the column A.

But every time I use the macro, I get the following error:

Sub SortAndRemoveDUBS()

Dim Rng As Range
Dim LastRow As Long
Dim i As Long

Application.ScreenUpdating = False

LastRow = Cells(Rows.Count, "B").End(xlUp).Row

Set Rng = Range("A4:P" & LastRow)

With Rng
    .Sort Key1:=Range("A4"), Order1:=xlAscending, key2:=Range("P4"), order2:=xlDescending, _
        Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
        Orientation:=xlTopToBottom
End With

Dim arr() As Variant
Dim cnt As Long

cnt = 0

For i = LastRow To 2 Step -1
    If WorksheetFunction.CountIf(Range(Cells(2, "A"), Cells(i, "A")), Cells(i, "A")) > 1 Then
  ReDim Preserve arr(cnt)
  arr(cnt) = i
  cnt = cnt + 1
End If
Next i

If Len(Join(arr)) > 0 Then ActiveSheet.Range("A" & Join(arr, ",A")).EntireRow.Delete

Application.ScreenUpdating = True

End Sub

This line gets highlighted:

ActiveSheet.Range("A" & Join(arr, ",A")).EntireRow.Delete

Does someone see what the probleme is?

Not the answer but another way might be deleting rows in the for loop? — ali srn
– ali srn, Commented Sep 20, 2016 at 7:56
I think that will slow down the macro? I had a another version before, but it was too slow for that many rows. — Bluesector
– Bluesector, Commented Sep 20, 2016 at 8:01
Yes, that could be your last option if you cant find an answer. I am not familiar with join function, so I cant help here. — ali srn
– ali srn, Commented Sep 20, 2016 at 8:06
Maybe you can loop in arr elements in a for loop and create a range or select them and then delete at once. — ali srn
– ali srn, Commented Sep 20, 2016 at 8:09
Did you try to work this code, activesheet.range("A2", "A4", "A6").entirerow.delete ? — ali srn
– ali srn, Commented Sep 20, 2016 at 8:13

user3598756 · Accepted Answer · 2016-09-20 10:23:14Z

3

Use RemoveDuplicates()

and, since you remove all duplicates from column "A" either you sort on column "A" or on column "P": I assume you need this latter

Sub SortAndRemoveDUBS()
    With Worksheets("MyDataSheet") '<--| change "MyDataSheet" to your actual worksheet name
        With Range("A4:P" & .Cells(.Rows.Count, "B").End(xlUp).Row)
            .RemoveDuplicates Columns:=Array(1)
            .Sort Key1:=Range("P4"), order1:=xlDescending, _
                Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
                Orientation:=xlTopToBottom
        End With
    End With
End Sub

answered Sep 20, 2016 at 10:23

user3598756

29.5k4 gold badges20 silver badges30 bronze badges

Sign up to request clarification or add additional context in comments.

2 Comments

user3598756 Over a year ago

@ShaiRado, a really nice feature of Excel. Thank you

Bluesector Over a year ago

removes the duplicates... but for some reason the sort does not work how its intended. I sort column P because is has dates in it. he should keep the dates which are the newst/in future ||| NOW IT WORKS - I putted the .RemoveDuplicates at the bottom. |||

Darren Bartrup-Cook · Accepted Answer · 2016-09-20 09:01:02Z

If you want to remove all duplicates except the first one then this code will work in 2007+:

Sub SortAndRemoveDUBS()

    Dim Rng As Range
    Dim LastRow As Long

    Application.ScreenUpdating = False

    LastRow = Cells(Rows.Count, "B").End(xlUp).Row

    Set Rng = Range("A4:P" & LastRow)

    With Rng
        .Sort Key1:=Range("A4"), Order1:=xlAscending, key2:=Range("P4"), order2:=xlDescending, _
            Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
            Orientation:=xlTopToBottom
    End With

    Rng.RemoveDuplicates Columns:=1, Header:=xlYes

    Application.ScreenUpdating = True

End Sub

Edit: If you want to remove all duplicates this code will do the job:

Sub SortAndRemoveDUBS()

    Dim Rng As Range
    Dim LastRow As Long
    Dim i As Long
    Dim RngToDelete As Range

    Application.ScreenUpdating = False

    LastRow = ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, "B").End(xlUp).Row

    Set Rng = ThisWorkbook.Worksheets("Sheet1").Range("A4:P" & LastRow)

    With Rng
        .Sort Key1:=Range("A4"), Order1:=xlAscending, key2:=Range("P4"), order2:=xlDescending, _
            Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
            Orientation:=xlTopToBottom

        For i = LastRow To 4 Step -1
            If WorksheetFunction.CountIf(.Resize(, 1), .Cells(i - 3, 1)) > 1 Then
                If RngToDelete Is Nothing Then
                    Set RngToDelete = .Cells(i - 3, 1).EntireRow
                Else
                    Set RngToDelete = Union(RngToDelete, .Cells(i - 3, 1).EntireRow)
                End If
            End If
        Next i
    End With

    If Not RngToDelete Is Nothing Then
        RngToDelete.Delete
    End If

    Application.ScreenUpdating = True

End Sub

0m3r · Accepted Answer · 2016-09-20 09:00:08Z

1

Try using Application.WorksheetFunction.Match method

Example

Option Explicit
Sub Function_Match()
    Dim vRow As Variant
    Dim i As Long, LastRow As Long

    LastRow = WorksheetFunction.CountA(Columns(1))

    For i = LastRow To 2 Step -1
        vRow = Application.Match(Cells(i, 1).Value, Range(Cells(1, 1), Cells(i - 1, 1)), 0)
        If Not IsError(vRow) Then
            Rows(vRow).Delete
        End If
    Next

End Sub

answered Sep 20, 2016 at 9:00

0m3r

12.5k15 gold badges40 silver badges77 bronze badges

Collectives™ on Stack Overflow

Excel VBA - Removing duplicates

3 Answers 3

2 Comments

1 Comment

Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

3 Answers 3

2 Comments

1 Comment

Comments

Your Answer

Sign up or log in

Post as a guest

Related