VBA - Delete duplicates in a FILTERED column

Question

I'm looking for a quick way to delete duplicates in a specific column but only in a filtered range. So, basically I would like it only delete visible duplicate values, but leave the rest that is "unfiltered and hidden".

I have this piece of code and have no idea how to alter it to do so:

ActiveSheet.Range("A:ZZ").RemoveDuplicates Columns:=Array(3), Header:=xlYes

Could you please help? Is there any easy way to edit the existing code to do this?

*For example:

Column A= Continent
Column B= Country
Column C= City

If I filter the country by India (col B) I see various cities repeated many times (col C). I would like to delete duplicates and see only one of each city. However, I don't want the duplicates to be deleted for the other countries.*

elmer007 · Answer 1 · 2017-01-24T14:00:27.967

You can remove duplicates for all Continent-Country-City combinations without filtering by specifying all 3 in your RemoveDuplicates arguments. This isn't exactly answering your question, but it might be the solution you need with one less step.

For your example with columns A, B, and C as Continent, Country, and City, how about the following:

ActiveSheet.Range("A:C").RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlYes

Note the Array portion specifies columns 1, 2, and 3 from the range to be evaluated, which will look for duplicates across all 3 columns (instead of just column 3 from your existing code).

I would suggest testing this on a copy of your data since macros do not allow "undo".

Here's a screenshot of a sample. The original list is on the right, and the resulting list is on the left (in columns A-C). Note "London" and "Birmingham":

I mean something a bit different: using your example from above - I would like to delete duplicate cities for Spain but leave all the other duplicates for the rest of the countries. — , Jan 24 '17 at 14:15
@Coco I see- I was afraid that might be a requirement... In that case, this is not the solution for you, sorry — elmer007, Jan 24 '17 at 14:23

score 0 · Answer 2 · answered Jan 24 '17 at 14:38

You might be after the SpecialCells(xlCellTypeVisible) property of the Range object. So your code could be:

ActiveSheet.Range("A:ZZ").SpecialCells(xlCellTypeVisible).RemoveDuplicates Columns:=Array(3), Header:=xlYes

It does leave empty rows, though, once you remove the filter. The only other way I know of (which doesn't leave empty rows) is to remove the duplicates with your own duplicate-finding routine. The SpecialCells property can still be used to check filtered data only. Something like this:

Dim uniques As Collection
Dim cell As Range, del As Range
Dim exists As Boolean
Dim key As String

Set uniques = New Collection
For Each cell In ActiveSheet.Range("A:ZZ").Columns(3).SpecialCells(xlCellTypeVisible).Cells
    key = CStr(cell.Value2)
    exists = False
    On Error Resume Next
    exists = uniques(key)
    On Error GoTo 0
    If Not exists Then
        uniques.Add True, key
    Else
        If del Is Nothing Then
            Set del = cell
        Else
            Set del = Union(del, cell)
        End If
    End If
Next
If Not del Is Nothing Then
    del.EntireRow.Delete
End If

score 0 · Answer 3 · answered Jan 24 '17 at 18:06

Maybe you need a custom VBA dup-remover. Try this:

Sub RemoveVisibleDupes(r As Range, comparedCols)
    Dim i As Long, j As Long, lastR As Long
    i = r.Row: lastR = r.Row + r.Rows.count - 1
    Do While i < lastR
        For j = lastR To i + 1 Step -1
            If Not (r.Rows(i).Hidden Or r.Rows(j).Hidden) And areDup(r.Rows(i), r.Rows(j), comparedCols) Then
                r.Rows(j).Delete
                lastR = lastR - 1
            End If
        Next
    i = i + 1
    Loop
End Sub

Function areDup(row1 As Range, row2 As Range, comparedCols) As Boolean
    Dim col
    For Each col In comparedCols
        If row1.Cells(col).Value <> row2.Cells(col).Value Then Exit Function
    Next
    areDup = True
End Function

Testing

Sub TestIt()
    On Error GoTo Finish
    Application.DisplayAlerts = False: Application.EnableEvents = False: Application.ScreenUpdating = False

    ' call our custom dup-remover on filtered columns A:C with comparing columns 1 and 3
    RemoveVisibleDupes Sheet2.Range("A1:C" & Sheet2.Cells(Sheet2.Rows.count, 1).End(xlUp).Row), Array(1, 3)
    ' To use it with one column only, say 3, replace Array(1, 3) with array(3)

Finish:
    Application.DisplayAlerts = True: Application.EnableEvents = True: Application.ScreenUpdating = True
End Sub

VBA - Delete duplicates in a FILTERED column

3 Answers3