Highlight Rows of Duplicate results column with unique coloring

Originally Posted by scottiex

How would this be useful?

regardless try this.

...
End Sub[/CODE]

Scottiex, thanks for the attempt but it resulted in the last record in a group being highlighted, and after about 20 lines every line was highlighted irrespective of duplicate values.
To answer your question, this is useful as we are merging two data sets from different MCOs which share services and part numbers. We need to easily identify where a service and part number repeated for audit purposes.

This morning I found the following script which is very close to what I want but it is looking duplicates in column A not F. I'm not sure how to alter it in this regard.

Sub HighlightUniqueDuplicatesGC()
Dim sh As Worksheet, c As Range, clr As Variant, lr As Long
Set sh = ActiveSheet
lr = sh.Cells(Rows.Count, 1).End(xlUp).Row
clr = Array(3, 4, 6, 7, 8, 10, 12, 13, 14, 15, 16, 17, 18, 19, 20, 22, 23, 24, 26, 27, 28, 31, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 50, 53, 54)
With sh
.Range("A1:A" & lr).AdvancedFilter xlFilterCopy, , .Range("B" & lr + 2), True
x = LBound(clr)
For Each c In .Range("B" & lr + 4).CurrentRegion
.UsedRange.AutoFilter 1, c.Value
If Application.CountIf(.Range("A:A"), c.Value) > 1 Then
.Range("A2", .Cells(Rows.Count, 1).End(xlUp)).SpecialCells(xlCellTypeVisible).EntireRow.Interior.ColorIndex = clr(x)
End If
.AutoFilterMode = False
x = x + 1
If x > UBound(clr) Then x = LBound(clr)
Next
.Range("B" & lr + 2).CurrentRegion.Delete
End With
End Sub

Originally Posted by scottiex

OK seems I misunderstood your requirement.

messy coding but here is a quick fix that seems to work... I see they limited the colours presumably to retain contrast.

Sub HighlightUniqueDuplicatesGC()
Dim sh As Worksheet, c As Range, clr As Variant, lr As Long
Set sh = ActiveSheet
lr = sh.Cells(Rows.Count, 6).End(xlUp).Row
clr = Array(3, 4, 6, 7, 8, 10, 12, 13, 14, 15, 16, 17, 18, 19, 20, 22, 23, 24, 26, 27, 28, 31, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 50, 53, 54)
With sh
.Range("F1:F" & lr).AdvancedFilter xlFilterCopy, , .Range("EE" & lr + 2), True
x = LBound(clr)
For Each c In .Range("EE" & lr + 4).CurrentRegion
.UsedRange.AutoFilter 1, c.Value
If Application.CountIf(.Range("F:F"), c.Value) > 1 Then
.Range("F2", .Cells(Rows.Count, 6).End(xlUp)).SpecialCells(xlCellTypeVisible).EntireRow.Interior.ColorIndex = clr(x)
End If
.AutoFilterMode = False
x = x + 1
If x > UBound(clr) Then x = LBound(clr)
Next
.Range("EE" & lr + 2).CurrentRegion.Delete
End With
End Sub

"To answer your question, this is useful as we are merging two data sets from different MCOs which share services and part numbers. We need to easily identify where a service and part number repeated for audit purposes."

I see why they would ask for that, I sometimes get asked for that sort of thing. But there should be a better way. I presume once they find a duplicate they take some action and I imagine having a helper column with some indicator of what to do would be more useful.

Thanks for the followup Scottiex.
I ran the new code but it yielded a runtime error. I tried pre-selecting (highlighting) the range before running the code as well, to see if that would limit but same error.
I am attaching an excerpt of sample data which I have manually highlighted lines to what I am hoping the end result would be (again, based on column F being duplicate. more obvious in the last records).
Thanks again.