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, Sep 20 '16 at 07: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, Sep 20 '16 at 08: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, Sep 20 '16 at 08: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, Sep 20 '16 at 08:09
Did you try to work this code, activesheet.range("A2", "A4", "A6").entirerow.delete ? — ali srn, Sep 20 '16 at 08:13
I tried, and it is not working. You have to try a different algorithm here. — ali srn, Sep 20 '16 at 08:15
Why do you have comma `,` - `,A` remove it and see if that helps `(arr, "A")` — 0m3r, Sep 20 '16 at 08:20
Assign this ("A" & Join(arr, ",A")) to a string and see what is wrong. Because I wrote a minimal version of your code and it worked. when I was trying, I saw several problems with that string. like "A, A1" at the start or ",A" at the end — ali srn, Sep 20 '16 at 08:47

Darren Bartrup-Cook · Answer 1 · 2016-09-20T09:01:02.160

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

does not work... "The sort reference is not valid.[...]". – Bluesector Sep 21 '16 at 06:43 — Bluesector, Sep 21 '16 at 06:43

score 3 · Accepted Answer · answered Sep 20 '16 at 10:23

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 '16 at 10:23

user3598756

28,893
4
18
28

@ShaiRado, a really nice feature of Excel. Thank you – user3598756 Sep 20 '16 at 12:13
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. ||| – Bluesector Sep 21 '16 at 06:51

score 1 · Answer 3 · answered Sep 20 '16 at 09:00

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

Excel VBA - Removing duplicates

3 Answers3