Highlighting Multiple Duplicate Values - Different Color

[t2true]

I have a list (8500 rows) of domain names, many of which are duplicates:


q.com
q.com
wp.pl
x.com
X.com
2go.us
cs.com
cs.com
gmx.us
me.com
me.com


I want to be able to highlight the duplicate domain names with different colors. (Conditional formatting does not work in this scenario; it highlights all duplicates the same color.)


q.com blue
q.com blue
wp.pl
x.com red
X.com red
2go.us
cs.com green
cs.com green
gmx.us
me.com yellow
me.com yellow


Ideally, if possible, I would like to highlight the entire row that contains the duplicate values.

Any suggestions?


NOTE: I do not know/understand VBA, so if that is the answer, please include specific details.




Thanks

 

[JLGWhiz]

I have a list (8500 rows) of domain names, many of which are duplicates:


q.com
q.com
wp.pl
x.com
X.com
2go.us
cs.com
cs.com
gmx.us
me.com
me.com


I want to be able to highlight the duplicate domain names with different colors. (Conditional formatting does not work in this scenario; it highlights all duplicates the same color.)


q.com blue
q.com blue
wp.pl
x.com red
X.com red
2go.us
cs.com green
cs.com green
gmx.us
me.com yellow
me.com yellow


Ideally, if possible, I would like to highlight the entire row that contains the duplicate values.

Any suggestions?


NOTE: I do not know/understand VBA, so if that is the answer, please include specific details.




Thanks

there is a limited number of colors, espcially those suitable for highlighting. How many unique URLs do you think are duplicated and which colors would you prefer to use, assuming that some will be repeated? Also, which column contains the URLs?

 

[JLGWhiz]

Assume col A is the column with URLs.

Sub hiLiteDupe()
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, 5, 6, 7, 8, 9, 10)
    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

If you want to try the macro, copy it to the standard code module 1. see below for access and run instructions.

 

[t2true]

Thanks for the response.


There are about 60 different domain names in the list.
They are listed in cells B2 - B8794

 

[JLGWhiz]

OK, This modified version extends the colors out to 20, which would allow 1/3 of the domain names which might be duplicated to have a unique color. If you want to add colors or delete them, simply modifiy the color numbers in the Array. Some colors in the 56 color palette may not be conducive to use as a highlight, so you can delete that color number (if you can figure out which one it is) from the Array and add in a new one to replace it. Good luck

Sub hiLiteDupe2()
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, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22)
    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

 

[t2true]

That's great info. Worked like a charm.

Thanks again.

 

[JLGWhiz]

That's great info. Worked like a charm.

Thanks again.

You're welcome,
regards, JLG

 

[pdinphx]

I realize this is an old thread, but the vba code was awesome. Thank you!

Pj
Phoenix, AZ

 

[laam090]

I have similar context but values i have are more than 56 so what do i need to do to add more colours?

 

[laam090]

I have similar context but values i have to highlight are more than 56 , it is even more than 500 so what do i need to do? Is there any code?