Find duplicates in a column and change text color

[zoodaddy]

I am trying to find duplicates in a column and change the font color
The column is text formatted
some cells have one number others have multiple numbers separated with a comma and space
can anyone help in writing a macro to do this ?
example below
Thanks

|2 |
|13 |
|2 |
|10, 11, 13 |
|2, 4, 5, 9 |
|10 |
|8 |

 

[SkipVought]

Hi,

What's the business case for this requirement?

How many rows of data in your sheet?

How many possible "duplicates?"

How will specific colors be assigned (relates to the number of possible duplicates)?

Plz answer all 4 of these questions.

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[zoodaddy]

Skip
Sorry for the late response.
What's the business case for this requirement? Maintenance and I'm data collecting from a PLC
How many rows of data in your sheet? Max 100
How many possible "duplicates?" ~10
How will specific colors be assigned (relates to the number of possible duplicates)? No Specific color assignment just want to group duplicate in the same color and to be visually noticed

Thanks

 

[SkipVought]

Maintenance.

Is this related to maintaining a data base or maintenance of some entity external to the data base? Either way you have data to manipulate and analyse.

Colors are for reporting effectiveness, impact, telling a story. Here, you may have 100 rows and nine shades of color to associate. If it were me (not really knowing the reason for this report) there are better ways of associating data foe analysis than like shades, especially colors within a string.

But with this information, I'll taks a shot at a solution. Yesterday observed a total eclipse of the sun in Missouri and now I have some time to code.



Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[SkipVought]

BTW, have you tried any code yet?

The fact that you have partial text within a cell that needs to be shaded, complicates things quite a bit.

I could give you a few tips regarding the process, but I'm not so sure I want to invest the time while I'm vacationing.

I'd loop through the range of cells.
Then within that loop I'd loop through each cell value using Split() on the COMMA.
I'd get the split value (which may be only one value) and then use the Find Method to search for another match in succeeding cells in the range.
If found then... and here's where it gets tricky... use the Characters() Method to pick off the first and last characters in the cell value to assign the color.
Oh yes, I'd FIRST set up a my choice of 9 colors on a separate sheet in a range named Colors.
Of course you will have TWO ranges at any point: the Source range and the Found range. So the Characters Method must be applied to both ranges to color the duplicate values. BTW, using an index for the colors, you must do a FindNext until all duplicates are found, then increment the color index and on to the next value, maybe in the same cell value or maybe in the next cell.

So it ain't easy zd. Mebe take a try at coding it and come back with your questions.

The other issue is that I have no internet access for my laptop, while I do for my iPad, which has no Excel.

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[zoodaddy]

Hey Skip
Thank you very much for your replies
I made a change to the code I already had.
rather than putting a comma to separate the numbers in the cell
I put the the individual numbers in the next column of that row.
it made searching for Duplicates a lot easier.
Enjoy your Vacation Skip

 

[SkipVought]

Plz post your solution, as there are other members that would benefit.

Now that you simplified things, here's my solution. On sheet Factors I have my interior colors in Named Range, Colors...

Sub ShadeCells()
'SkipVought 2017 AUG 22
'separate sells for each value
'only cells to search/shade on this sheet
    Dim r As Range, rng As Range, rFound As Range, rColors As Range
    Dim i As Integer, iColor As Integer, lFoundRow As Long
    
    Set rColors = Sheets("Factors").Range("Colors")
    Set rng = ActiveSheet.UsedRange
    
    For Each r In rng
    'check for non-empty cells
        If Len(r.Value) > 0 Then
        'check for black font color
            If r.Font.Color = 0 Then
                Set rFound = rng.Find(r.Value, r, , xlWhole)
                'check for match
                If Not rFound Is Nothing Then
                'check that the found cell is not the source cell
                    If Intersect(r, rFound) Is Nothing Then
                        lFoundRow = rFound.Row
                        Do
                            r.Font.Color = rColors.Cells(iColor + 1, 1).Interior.Color
                            rFound.Font.Color = rColors.Cells(iColor + 1, 1).Interior.Color
                            
                            Set rFound = rng.FindNext(rFound)
                            'check if the find has wrapped around
                            If lFoundRow > rFound.Row Then
                                iColor = iColor + 1
                                Exit Do
                            End If
                        Loop
                    End If
                End If
            End If
        End If
    Next
End Sub

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]