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

Fractalis

Active Member
Joined
Oct 11, 2011
Messages
252
Hi,

I have data in a sheet with something like this:


ABCD
File1
Abs145YuoJ002
RFG2343op009
File2
UYR234yyt3nn
POC778www334
File3
WEF778O93R67
TRE77887K004

<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.
 

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.

Tim_Excel_

Well-known Member
Joined
Jul 12, 2016
Messages
512
Code:
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
 
Last edited:

Fractalis

Active Member
Joined
Oct 11, 2011
Messages
252
Code:
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.
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,163,785
Messages
5,833,690
Members
430,222
Latest member
Nickkarl

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top