Highlighting rows with random colors if there are duplicates in one column

[korak30]

Hello, I'd like to highlight rows with random colors if there are duplicates (anywhere between 3-10) in one of the columns. My data set looks like this:

1_800_flowerscom	1 Old Country Rd Ste 500	Carle Place	NY	11514-1847	United States
1_800_flowerscom	1 Old Country Rd Ste 500	Carle Place	NY	11514-1847	USA
1_automotive_group	950 Echo Lane	Houston	TX	77024-2756	United States
1_automotive_group	800 Gessner Rd Ste 500	Houston	TX	77024-4498	United States
1_automotive_group	950 Echo Lane	Houston	TX	77024-2756	United States of America
1_chambers_court_family_garden_law
1_chambers_court_family_garden_law	1 Garden Court Temple	London		EC4Y 9BJ	United Kingdom

<colgroup><col><col><col><col><col><col></colgroup><tbody>
</tbody>

Basically I'd like to highlight the rows, for duplicate values in column A, with a unique color. The reason I need a random color is because there are 17000 rows.

I've tried some basic conditional formatting but that's not working.

Any help is much appreciated. Thanks!

 

[korak30]

I've tried something along the lines of the following

Sub test()
Worksheets("Remaining Groups").Range("A1:AC17265").Select


Do While ActiveCell.Text <> Empty
Do While ActiveCell = True
ActiveCell.Offset(0, 5).Resize(2, -5).Interior.Color = RGB(Int((255 * Rnd)), Int((255 * Rnd)), Int((255 * Rnd)))
Loop
ActiveCell.Offset(1, 0).Select
Loop
End Sub

But it's not working.. anybody? Thank you so much!

 

[farmerscott]

Korak30,

Have a try of this code. It will only highlight duplicates in Col A.

Sub ColourDuplicates()
Dim Rng As Range
Dim Cel As Range
Dim Cel2 As Range
Dim Colour As Long




Set Rng = Worksheets("Sheet1").Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
Rng.Interior.ColorIndex = xlNone
Colour = 6
For Each Cel In Rng


If WorksheetFunction.CountIf(Rng, Cel) > 1 And Cel.Interior.ColorIndex = xlNone Then
Set Cel2 = Rng.Find(Cel.Value, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False, SearchDirection:=xlNext)
    If Not Cel2 Is Nothing Then
        Firstaddress = Cel2.Address
        Do
        Cel.Interior.ColorIndex = Colour
        Cel2.Interior.ColorIndex = Colour
            Set Cel2 = Rng.FindNext(Cel2)
        
        Loop While Firstaddress <> Cel2.Address
    End If




Colour = Colour + 1


End If
Next


End Sub

 

[korak30]

Scott,

That was wonderful!!

Could you guide me on how to modify this to highlight the entire row?

Thank you so much!

 

[farmerscott]

Do you want the "entire row" or just the columns with data in them? If so, what is the last col?

 

[korak30]

The columns with the data. I'm sorry I should have specified! The column with the repetitions to be identified is column B, but the data ranges from column A to Z.

Thanks!

 

[korak30]

Additionally, the macro keeps stopping at row 106 with a "Subscript Out Of Range Error".

 

[farmerscott]

Try-

Sub ColourDuplicates2()
Dim Rng As Range
Dim Cel As Range
Dim Cel2 As Range
Dim Colour As Long




Set Rng = Worksheets("Sheet1").Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
Rng.Interior.ColorIndex = xlNone
Colour = 6


For Each Cel In Rng

If WorksheetFunction.CountIf(Rng, Cel) > 1 And Cel.Interior.ColorIndex = xlNone Then
Set Cel2 = Rng.Find(Cel.Value, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False, SearchDirection:=xlNext)
    If Not Cel2 Is Nothing Then
        Firstaddress = Cel2.Address
        Do
        Cel.Offset(0,-1).Resize(1,26).Interior.ColorIndex = Colour
        Cel2.Offset(0,-1).Resize(1,26).Interior.ColorIndex = Colour

           Set Cel2 = Rng.FindNext(Cel2)
        
        Loop While Firstaddress <> Cel2.Address
    End If




Colour = Colour + 1


End If
Next


End Sub

 

[korak30]

Yes it still says Subscript out of Range again, unfortunately.

I've also stumbled upon another challenge.

The data I have is below:

5 1_800_flowerscom Legal GSO SFDC 1 Old Country Rd Ste 500 Carle Place NY 11514-1847 United States 6 1_800_flowerscom InterAction 1 Old Country Rd Ste 500 Carle Place NY 11514-1847 USA 7 1_automotive_group Legal GSO SFDC 950 Echo Lane Houston TX 77024-2756 United States 8 1_automotive_group EPM SFDC 800 Gessner Rd Ste 500 Houston TX 77024-4498 United States 9 1_automotive_group InterAction 950 Echo Lane Houston TX 77024-2756 United States of America 10 1_chambers_court_family_garden_law InterAction 11 1_chambers_court_family_garden_law Legal GSO SFDC 1 Garden Court Temple London EC4Y 9BJ United Kingdom 12 1_chancery_lane Legal GSO SFDC 1 Chancery Lane London WC2A 1LF United Kingdom 13 1_chancery_lane InterAction 14 1_court_hare Legal GSO SFDC 1 Hare Court Temple London EC4Y 7BE United Kingdom 15 1_court_hare InterAction 16 1_court_pump InterAction 1 Temple London EC4Y 7AB United Kingdom 17 1_court_pump Legal GSO SFDC 1 Pump Court Chambers Elm Court, Temple London EC4Y 7AH United Kingdom 18 1031_group_tax Legal GSO SFDC - Elite Richmond VA 23235 US 19 1031_group_tax InterAction 100 Corporate Dr Ste 201 Trumbull CT 06611-6343 United States 20 11_bench_kings_walk InterAction 3 Park Court Leeds LS1 2QH United Kingdom 21 11_bench_kings_walk Legal GSO SFDC 3 Park Court Leeds LS1 2QH United Kingdom 22 12_benchwalk_kings Legal GSO SFDC 12 King's Benchwalk Temple London EC4Y 7EL United Kingdom 23 12_benchwalk_kings InterAction 12 King's Benchwalk Temple London EC4Y 7EL United Kingdom <colgroup><col><col><col><col><col><col><col><col></colgroup><tbody> </tbody>

<colgroup><col><col><col><col><col><col><col><col></colgroup><tbody>
</tbody>

I now need to match columns D, E and G, and report how many matches, 1,2 or 3 there are for each set of duplicates.

Is this something that can be done?

I'm sorry I'm asking so much, I'm pretty stressed about this.

 

[farmerscott]

Is there anything special/different at row 106?

Is the code doing everything right up to this point?

In your post #9 can you give an example of the matching you are referring to.