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

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

CodePudding user response：

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