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
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