Group rows with same value in column B and set different background color for each group

[Fractalis]

Hi,

I have data in a sheet with something like this:

A	B	C	D
File1
Abs	145	YuoJ	002
RFG	234	3op	009
File2
UYR	234	yyt	3nn
POC	778	www	334
File3
WEF	778	O93	R67
TRE	778	87K	004

<tbody>
</tbody>

I would like to colorize with the same background color all rows that have the same value in column B and if there are different values in column B colorize with different colors those rows.

For example in this table,
- all rows in range A:D where value in B is 145 the background is green
- all rows in range A:D where value in B is 234 the background is blue
- all rows in range A:D where value in B is 778 the background is red

May someone help me to do this?

Thanks for any help.

 

[Tim_Excel_]

Sub colourbyval()

Dim LRow As Long
Dim valarr As Variant
Dim i As Long
Dim b As Variant
Dim alreadypresent As Boolean
Dim xRed As Byte
Dim xGreen As Byte
Dim xBlue As Byte


With ThisWorkbook.Sheets(1)


LRow = .Cells(.Rows.Count, "B").End(xlUp).Row
i = 0


ReDim valarr(i)


For Each c In .Range("B2:B" & LRow)
    alreadypresent = False
    
    If IsEmpty(valarr(0)) Then valarr(0) = c.Value
    
    For Each itm In valarr
        If itm = c.Value Then
            alreadypresent = True
            Exit For
        End If
    Next itm
    
    If alreadypresent = False Then
        i = i + 1
        ReDim Preserve valarr(i)
        valarr(i) = c.Value
    End If
Next c


For Each b In valarr
    xRed = Application.WorksheetFunction.RandBetween(0, 255)
    xGreen = Application.WorksheetFunction.RandBetween(0, 255)
    xBlue = Application.WorksheetFunction.RandBetween(0, 255)
    
    .Range("A:D").AutoFilter Field:=2, Criteria1:=b
    .Range("A2:D" & LRow).SpecialCells(xlCellTypeVisible).Interior.Color = RGB(xRed, xGreen, xBlue)
Next b


.Range("A:D").AutoFilter


End With
End Sub

This code first puts all distinct values in an array, and then loops through this array to filter for these values and give all the rows of the same value a random colour

 

[Fractalis]

Sub colourbyval()

Dim LRow As Long
Dim valarr As Variant
Dim i As Long
Dim b As Variant
Dim alreadypresent As Boolean
Dim xRed As Byte
Dim xGreen As Byte
Dim xBlue As Byte


With ThisWorkbook.Sheets(1)


LRow = .Cells(.Rows.Count, "B").End(xlUp).Row
i = 0


ReDim valarr(i)


For Each c In .Range("B2:B" & LRow)
    alreadypresent = False
    
    If IsEmpty(valarr(0)) Then valarr(0) = c.Value
    
    For Each itm In valarr
        If itm = c.Value Then
            alreadypresent = True
            Exit For
        End If
    Next itm
    
    If alreadypresent = False Then
        i = i + 1
        ReDim Preserve valarr(i)
        valarr(i) = c.Value
    End If
Next c


For Each b In valarr
    xRed = Application.WorksheetFunction.RandBetween(0, 255)
    xGreen = Application.WorksheetFunction.RandBetween(0, 255)
    xBlue = Application.WorksheetFunction.RandBetween(0, 255)
    
    .Range("A:D").AutoFilter Field:=2, Criteria1:=b
    .Range("A2:D" & LRow).SpecialCells(xlCellTypeVisible).Interior.Color = RGB(xRed, xGreen, xBlue)
Next b


.Range("A:D").AutoFilter


End With
End Sub

This code first puts all distinct values in an array, and then loops through this array to filter for these values and give all the rows of the same value a random colour

Thanks so much for your help Tim.I got the idea of your logic. I'll try to test in real file.

 

[Tim_Excel_]

Glad to have helped and good luck