excelvbavisibleadvanced-filter

How to hide visible duplicate cells using AdvancedFilter or any other possible methods?


I need to hide visible duplicate cells in a range.
With using AdvancedFilter, yes it hides the duplicate cells (entire row) But It also show all the hidden rows in the respective range.
I tried to use SpecialCells(xlCellTypeVisible) method, But I got the following error:

Run-time error '1004': Database or table range is not valid.

If it is not applicable to use AdvancedFilter, What are the other possible methods?
As always, gratfull for all your help.

Sub Hide_Visible_Duplicate_Cells()
 
    Dim ws As Worksheet, arng As Range, LastR As Long
 
    Set ws = ThisWorkbook.ActiveSheet
 
    LastR = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
 
    Set arng = ws.Range("A1:A" & LastR)
 
    arng.SpecialCells(xlCellTypeVisible).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=arng, Unique:=True
 
End Sub

Solution

  • Please, try the next adapted code. It uses a dictionary to detect which rows to be hidden (only after the dictionary key has been created) and set a Union range for the respective cells. Finally, EntireRow of this range will be hidden:

    Sub Hide_Visible_Duplicate_Cells()
        Dim ws As Worksheet, arng As Range, LastR As Long
        Dim C As Range, UnRng As Range, dict As New Scripting.Dictionary
     
        Set ws = ThisWorkbook.ActiveSheet
        LastR = ws.Range("A" & ws.rows.count).End(xlUp).row
        On Error Resume Next 'just for the (improbable) case when no cell exist in the respective range
         Set arng = ws.Range("A1:A" & LastR).SpecialCells(xlCellTypeVisible)
        On Error GoTo 0
        If arng Is Nothing Then Exit Sub
        
       For Each C In arng.cells
            If Not dict.Exists(C.Value) Then
                dict.Add C.Value, vbNullString 'keep the first occurrence
            Else
                addToRange UnRng, C            'create a Union range for the next occurrences
            End If
       Next C
       'hide the rows at once:
       If Not UnRng Is Nothing Then UnRng.EntireRow.Hidden = True
    End Sub
    
    Sub addToRange(rngU As Range, rng As Range) 'Add to the Union range...
        If rngU Is Nothing Then
            Set rngU = rng
        Else
            Set rngU = Union(rngU, rng)
        End If
    End Sub
    

    Please, send some feedback after testing it.

    Edited:

    The next suggested solution can be called from another Sub:

    Sub Hide_Visible_Dup_Cells(procRng As Range)
        Dim arng As Range, C As Range, UnRng As Range, dict As Object
     
        On Error Resume Next
         Set arng = procRng.SpecialCells(xlCellTypeVisible)
        On Error GoTo 0
        If arng Is Nothing Then Exit Sub
        
       Set dict = CreateObject("Scripting.Dictionary") 'no need of reference...
       For Each C In arng.cells
            If Not dict.Exists(C.Value) Then
                dict.Add C.Value, vbNullString
            Else
                addToRange UnRng, C
            End If
       Next C
       
       If Not UnRng Is Nothing Then UnRng.EntireRow.Hidden = True
    End Sub
    

    For the above case, it can be called as:

    Sub tesHide_Visible_Dup_Cells()
          Dim ws As Worksheet, rng As Range, LastR As Long
          
          Set ws = ThisWorkbook.ActiveSheet
          LastR = ws.Range("A" & ws.rows.count).End(xlUp).row
          Set rng = ws.Range("A1:A" & LastR)
          
          Hide_Visible_Dup_Cells rng
    End Sub