Highlight Visible Duplicate Cells

Originally Posted by MickG

Hi, Here's a Selection change Event .Click "G1".after running your Column "H" Filter.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Rng As Range, Dn As Range, Cvis As Range
If Target.address(0, 0) = "G1" Then
    Set Rng = Range(Range("H1"), Range("H" & Rows.Count).End(xlUp))
        Rng.Offset(, -1).Interior.ColorIndex = xlNone
            Set Cvis = Rng.Offset(, -1).SpecialCells(xlCellTypeVisible)

With CreateObject("scripting.dictionary")
    .CompareMode = vbTextCompare
        For Each Dn In Cvis
            If Dn.Value <> "" And Not .Exists(Dn.Value) Then
                .Add Dn.Value, Dn.address
             ElseIf Dn.Value <> "" Then
                 Range(.Item(Dn.Value)).Interior.ColorIndex = 34
                 Dn.Interior.ColorIndex = 34
            End If
        Next Dn
End With
End If
End Sub

Regards Mick

Hi, I have made some progress but still lacking the duplicate script. I tried your script above but it highlights all the cells. from the filtered group? Also I cant use a worksheet change script as I have many worksheets to run my main script from.

Here is what I have so far:
This script will Filter all the values one at a time

Sub AutoFilterAutomated()
 Dim Uniq() As String, UniqLoop As Long
 Uniq = GetUniqueEntries(Columns("H"))
 For UniqLoop = 0 To UBound(Uniq)
  Cells.AutoFilter Field:=8, Criteria1:="=" & Uniq(UniqLoop)
  'Call Dup_Script
 Next
End Sub

Function GetUniqueEntries(ByVal TheRange As Range) As String()
 Dim TempArr() As String, TempCt As Long, CLL As Range, i As Long
 Set TheRange = Intersect(TheRange, TheRange.Parent.UsedRange)
 TempCt = 0
 For Each CLL In TheRange.Cells
  For i = 0 To TempCt - 1
   If TempArr(i) = CLL.Text Then Exit For
  Next 'i
  If i = TempCt Then
   ReDim Preserve TempArr(TempCt)
   TempArr(TempCt) = CLL.Text
   TempCt = TempCt + 1
  End If
 Next 'CLL
 GetUniqueEntries = TempArr
End Function

Then I use this Script to find the first visible cell in column "G"

Sub NextVisibleRow()
Range("G5").Select
'ActiveCell.Offset(1, 0).Select
Do While ActiveCell.EntireRow.Hidden = True
ActiveCell.Offset(1, 0).Select
Loop

End Sub

Now the only part I need to get working is How to find only the duplicate numbers in Column "G" that are visible and Highlight them.

For example:
I run my first script and it finds Monday then it will Auto filter by Monday. I then run my find the first visible cell in "G" in this example it is "G20" So if I had a duplicate script it would find "G21" and "G25" and Highlight those 2 cells.

I searched all over the place for something that may work but haven't gotten any where. Some of the scripts that I found need to look at a selection and since I have only been able to get the first visible cell selected and not the entire range that is visible and have data in them I cant test those.

Anyway let me know if you can think of anything else that may help in my situation.

Thank You,Mike