JM1
JM1

Reputation: 1715

Highlight rows with different colors by groups of duplicates

How do I highlight rows with different colors by groups of duplicates?

I don't care about which colors are used per se, I just want the duplicate rows one color, and the next set of duplicates another color.

enter image description here

For example, if I wanted the '1s' green, the '2s' blue and so on. It goes up to 120 in my column.

Thank you.

Upvotes: 6

Views: 42195

Answers (5)

Riceboi
Riceboi

Reputation: 1

Found this code for excel VBA that worked to organize a large number of duplicates in different colors.

`Sub ColorCompanyDuplicates()
    'Updateby Extendoffice 20171222
    Dim xRg As Range
    Dim xTxt As String
    Dim xCell As Range
    Dim xChar As String
    Dim xCellPre As Range
    Dim xCIndex As Long
    Dim xCol As Collection
    Dim I As Long
    On Error Resume Next
    If ActiveWindow.RangeSelection.Count > 1 Then
    xTxt = ActiveWindow.RangeSelection.AddressLocal
    Else
    xTxt = ActiveSheet.UsedRange.AddressLocal
    End If
    Set xRg = Range("M10:P10010")
    If xRg Is Nothing Then Exit Sub
    xCIndex = 2
    Set xCol = New Collection
    For Each xCell In xRg
    On Error Resume Next
    If xCell.Value <> "" Then
    xCol.Add xCell, xCell.Text
    If Err.Number = 457 Then
    xCIndex = xCIndex + 1
    Set xCellPre = xCol(xCell.Text)
    If xCellPre.Interior.ColorIndex = xlNone Then xCellPre.Interior.Color = RGB(xRed, xGreen, xBlue)
    xCell.Interior.Color = xCellPre.Interior.Color
    ElseIf Err.Number = 9 Then
    MsgBox "Too many duplicate companies!", vbCritical, "Kutools for Excel"
    Exit Sub
    End If
    xRed = Application.WorksheetFunction.RandBetween(0, 255)
    xGreen = Application.WorksheetFunction.RandBetween(0, 255)
    xBlue = Application.WorksheetFunction.RandBetween(0, 255)
    On Error GoTo 0
    End If
    Next
    End Sub

Upvotes: 0

Shahriar
Shahriar

Reputation: 2380

I found this VBA in https://www.extendoffice.com/documents/excel/3772-excel-highlight-duplicate-values-in-different-colors.html:

Sub ColorCompanyDuplicates()
'Updateby Extendoffice
    Dim xRg As Range
    Dim xTxt As String
    Dim xCell As Range
    Dim xChar As String
    Dim xCellPre As Range
    Dim xCIndex As Long
    Dim xCol As Collection
    Dim I As Long
    On Error Resume Next
    If ActiveWindow.RangeSelection.Count > 1 Then
      xTxt = ActiveWindow.RangeSelection.AddressLocal
    Else
      xTxt = ActiveSheet.UsedRange.AddressLocal
    End If
    Set xRg = Application.InputBox("please select the data range:", "Kutools for Excel", xTxt, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    xCIndex = 2
    Set xCol = New Collection
    For Each xCell In xRg
      On Error Resume Next
      xCol.Add xCell, xCell.Text
      If Err.Number = 457 Then
        xCIndex = xCIndex + 1
        Set xCellPre = xCol(xCell.Text)
        If xCellPre.Interior.ColorIndex = xlNone Then xCellPre.Interior.ColorIndex = xCIndex
        xCell.Interior.ColorIndex = xCellPre.Interior.ColorIndex
      ElseIf Err.Number = 9 Then
        MsgBox "Too many duplicate companies!", vbCritical, "Kutools for Excel"
        Exit Sub
      End If
      On Error GoTo 0
    Next
End Sub

Upvotes: 0

Gangula
Gangula

Reputation: 7294

The solution by Gowtham is only specific to numbers and uses VBA. You can use the following workaround that works with any type of data and doesn't need VBA.

We could use another column that generates a unique value for all the duplicates using a formula and use the "Conditional Formatting > Color Scales" for that column. Screenshot below.

Color Scales

The formula that you can use is

"=ROW(INDEX(A$2:A$12,MATCH(A2,A$2:A$12,0)))"

In the above formula, A$2:A$12 is the range that we want to search for duplicates.

The formula basically searches for the first instance of the duplicate value in the given range and inputs the row number of that first instance.

P.S: In the above formula, the range "A$2:A$12" is a fixed range, using the above formula in a Table is much simpler as a Table Range is dynamic

One other benefit of using Table is that we can even sort the data to group the duplicate values together

=ROW(INDEX([Column1],MATCH(A2,[Column1],0)))

Upvotes: 6

SoopahTree
SoopahTree

Reputation: 116

Gowtham's answer is great, and I wouldn't have figured out the below without them! I had the same need for unique color assignment, however, I needed more variance than the 56 colors that colorindex provides, so I slightly modified Gowtham's code to provide a bit more variability by using RandBetween along with RGB to create randomized colors via randomized red, blue, and green values.

I kept the color range between 120 & 255, since some of the lower values could result in cells that were too dark to read, but you can certainly customize to your liking. The code below can certainly be improved upon, as I'm no expert, but it was able to obtain the 100+ colors needed.

EDIT: I will add that there is a possibility that RGB values could overlap. I just needed to color-code for visual aid; but if you will need strict unique color values, this code will not guarantee that.

Dim rCount, RandCol1, RandCol2, RandCol3, i As Long

rCount = Sheet1.Range("A" & Rows.Count).End(xlUp).Row

    For i = 1 To rCount
        If Sheet1.Cells(i, 1) = Sheet1.Cells(i + 1, 1) Then
            Sheet1.Cells(i + 1, 1).Interior.Color = RGB(RandCol1, RandCol2, RandCol3)
        Else
            If Sheet1.Cells(i + 1, 1) <> "" Then
                RandCol1 = WorksheetFunction.RandBetween(120, 255)
                RandCol2 = WorksheetFunction.RandBetween(120, 255)
                RandCol3 = WorksheetFunction.RandBetween(120, 255)
                Sheet1.Cells(i + 1, 1).Interior.Color = RGB(RandCol1, RandCol2, RandCol3)
            End If
        End If
    Next i

Upvotes: 0

Gowtham Shiva
Gowtham Shiva

Reputation: 3875

Try out this simple code and modify it per your needs. Its quite self explanatory,

Sub dupColors()
Dim i As Long, cIndex As Long
cIndex = 3
Cells(1, 1).Interior.ColorIndex = cIndex
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
    If Cells(i, 1) = Cells(i + 1, 1) Then
        Cells(i + 1, 1).Interior.ColorIndex = cIndex
    Else
        If Cells(i + 1, 1) <> "" Then
            cIndex = cIndex + 1
            Cells(i + 1, 1).Interior.ColorIndex = cIndex
        End If
    End If
Next i
End Sub

enter image description here

Upvotes: 2

Related Questions