Higlight duplicates in different colours (and the entire row connected) EXCEL

Question

I have a sheet with details regarding orders. In column G a specific value indicates what container (shipping container) the order is packed in.screenshot

I would like all duplicate container no. to be highlighted with different colors and their row with them.

Meaning: that when I have "container no. X" the entire row connected to X is one color and rows connected to "container no. Y" is another color and so on.

I would also like an automatic update of colors when something changes or when I hit "update values" in the data bar
Blank cells in column G should not to be colored.

Is this possible and if so, can someone help me out. I am very much a beginner with VBA.

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
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.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
End If
Next
End Sub

user_14895985 · Answer

This code does number 1 and 3.

Also, it only uses bright colors.

Sub ColorCompanyDuplicates()

Dim row_start As Long, last_row As Long, color_index As Long
Dim R As Long, last_col As Long, col As Long
Dim used_range As Range, paint_row As Boolean

'CONFIG -------------------------
row_start = 5 'first row of the data set
paint_row = True 'set to false if you want to paint only the column
'--------------------------------

color_index = 33
Set used_range = ActiveSheet.UsedRange

last_col = _
used_range.Columns.Count + used_range.Column - 1

last_row = _
Cells(Rows.Count, 7).End(xlUp).Row

'clean existing rows in container names
For R = row_start To last_row
    If Range("g" & R) <> "" Then
        Range("g" & R).Value = Split(Range("g" & R).Value, " ")(0)
    End If
Next R

'paint duplicates
For R = row_start To last_row

    'if the next container name is the same and is not null then paint
    If Cells(R, 7) = Cells(R + 1, 7) And Cells(R, 7) <> "" Then
        
        If paint_row Then
        
            For col = used_range.Column To last_col
                Cells(R, col).Interior.ColorIndex = color_index
            Next col
            
            Else
            For col = used_range.Column To last_col
                Cells(R, col).Interior.ColorIndex = 0
            Next col
            Cells(R, 7).Interior.ColorIndex = color_index
            
        End If
        
    'FOR THE LAST ONE in the group
    'if previews container name is the same and is not null then paint
    ElseIf Cells(R, 7) = Cells(R - 1, 7) And Cells(R, 7) <> "" Then
        
        If paint_row Then
            
            For col = used_range.Column To last_col
                Cells(R, col).Interior.ColorIndex = color_index
            Next col
            
            Else
            For col = used_range.Column To last_col
                Cells(R, col).Interior.ColorIndex = 0
            Next col
            Cells(R, 7).Interior.ColorIndex = color_index
            
        End If
        
        'and change color for the next group
        color_index = color_index + 1
        
        'avoid dark colors
        If color_index = 46 Then
            color_index = 33
        End If
        
    End If
    
Next R

'add row numbers to containers name
For R = row_start To last_row
      If Range("g" & R) <> "" Then
        Cells(R, 7) = Cells(R, 7) & " ROW:" & R
     End If
Next R

End Sub

I would suggest for number 2 just create a refresh button or a command shortcut.

Higlight duplicates in different colours (and the entire row connected) EXCEL

1 Answers