Highlight Visible Duplicate Cells

Hi,

I have included an example workbook to help with my problem.


What I would like to happen is to auto filter each value in Column "H" Once Auto Filter is engaged then I want to look at the visible cells in Column "G" each cell that is a duplicate in the visible range I want to Highlight those cells.

Anyone have anything to get me going?

Thanks as always, Mike

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

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

Originally Posted by Richard Buttrey

Hi,

One way would be to use a helper column and conditional formatting. In a helper column, say column I, enter =G5&H5 and copy this down your data.

Then using the Formula Is option within the conditional formatting in cell G5 enter

=COUNTIF(I:I,I5)>1

and set the background cell colour as required.

Now copy G5 and paste special formats down the rest of column G. Hide the helper column I if necessary.

Regards

Thank You for the help, I was able to use your suggestion to solve my problem,

Thanks Again, Mike