Cell-colouring macro

daba

New Member
Joined
Sep 2, 2005
Messages
13
.... I have 3 cells (vertical), that contain R,G,B values.

These "boxes" of the 3 cells is repeated 255 times, making 256 * 3 cells in total.

I want all 3 cells in each "box" to be coloured to those RGB values, whenever any one of them is changed.

I'm having a mental block at the moment, and don't know how to proceed.

I'm sure it must be striaght-forward, if someone could point me in the right direction.....
 

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off
hi daba,

This should do the trick:
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim nShft As Integer 'used to align the groups of cells
    Const rSt = 2 'first data row
    nShft = 1 - ((Target.Row - rSt) Mod 3)


    Range(Cells(Target.Row - 1 + nShft, 1), Cells(Target.Row + 1 + nShft, 1)).Interior.Color = _
                        RGB(Target.Offset(-1 + nShft), Target.Offset(nShft), Target.Offset(1 + nShft))


End Sub

just set rSt = to the row number of your first data row.

Just remember that this isn't going to show ever colour of the rainbow - for that you'll need 255^3=16571375 cells.

Hope this helps.

Regards

Peter
 
Upvote 0
hi daba,

This should do the trick:
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim nShft As Integer 'used to align the groups of cells
    Const rSt = 2 'first data row
    nShft = 1 - ((Target.Row - rSt) Mod 3)


    Range(Cells(Target.Row - 1 + nShft, 1), Cells(Target.Row + 1 + nShft, 1)).Interior.Color = _
                        RGB(Target.Offset(-1 + nShft), Target.Offset(nShft), Target.Offset(1 + nShft))


End Sub

just set rSt = to the row number of your first data row.

Just remember that this isn't going to show ever colour of the rainbow - for that you'll need 255^3=16571375 cells.

Hope this helps.

Regards

Peter

Thanks Peter, I'll take a look at it.... The 256 colours I am working with are obviously a subset of the millions available...
 
Upvote 0
@pjmorris

I think that you need to adapt your code ensure you are targeting a particular column. For example, with your code if I change, say, cell D3 the colours in A2:A4 change even though the numbers in those cells have not.
 
Upvote 0
Ha-ha, 2 Peter's....

I think that since I only need to set the colours once, I'll do it the hard way, by entering the RGB values manually in the cell background custom colour dialogs.

My cell "boxes" are on rows 23,24,25 : 27, 28,29 etc. x16 down, and then in columns 2, 4, 6, 8 etc. with a width of 14 to a row. So if I've got to write a lot of checking if I'm addressing a cell within those "boxes, it's going to get tedious.

I'll set the RGB's by hand, I've got a couple of hours free ....
 
Upvote 0
It is a little unclear exactly what you mean by "x16 down" (16 rows or 16 sets of 4 rows?), "width of 14 to a row" (14 columns altogether or 28 columns being 14 x every second column?) but you might be able to make something of this?

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim TR As Long, TC As Long, RelRw As Long
  
  Const Firstrow As Long = 23
  Const LastRow As Long = 38
  Const Lastcol As Long = 28
  
  If Target.Cells.Count = 1 Then
    TR = Target.Row
    TC = Target.Column
    RelRw = (TR - Firstrow + 1) Mod 4
    If TR >= Firstrow And TC <= Lastcol And TC Mod 2 = 0 And RelRw Mod 4 <> 0 Then
      With Target.Offset(-RelRw + 1).Resize(3)
        .Interior.Color = RGB(.Cells(1), .Cells(2), .Cells(3))
      End With
    End If
  End If
End Sub
 
Last edited:
Upvote 0
It is a little unclear exactly what you mean by "x16 down" (16 rows or 16 sets of 4 rows?), "width of 14 to a row" (14 columns altogether or 28 columns being 14 x every second column?) but you might be able to make something of this?

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim TR As Long, TC As Long, RelRw As Long
  
  Const Firstrow As Long = 23
  Const LastRow As Long = 38
  Const Lastcol As Long = 28
  
  If Target.Cells.Count = 1 Then
    TR = Target.Row
    TC = Target.Column
    RelRw = (TR - Firstrow + 1) Mod 4
    If TR >= Firstrow And TC <= Lastcol And TC Mod 2 = 0 And RelRw Mod 4 <> 0 Then
      With Target.Offset(-RelRw + 1).Resize(3)
        .Interior.Color = RGB(.Cells(1), .Cells(2), .Cells(3))
      End With
    End If
  End If
End Sub

If I could add a picture it would be easier to see what I've got, but never mind, as I said I only need to do the job once, so I'll paste the RGBs in, no point in making a macro that has to deat with 256 sets of 3 cells each.... but thanks for the example code, I'm sure it'll be useful at some point down the line....

When do I get the ability to add attachments ?
 
Last edited:
Upvote 0
Hi Peter,

You are, of course, entirely correct. I did think of checking the column (IF NOT INTERSECT etc), but it was late here (NZ) and I thought that getting the principal across would help the OP sufficiently!

Regards

Peter
 
Last edited:
Upvote 0
OK, so this manually setting the RGB values of the 3 vertical cells is getting tedious to the extreme, so am once again looking for a solution, macro or vba.

I think I can simplify things if I select the topmost of the 3 cells, and have a button on the worksheet to fire a macro to colour the 3 cells with the R,G,B colour values contained within those three cells.

I'll have a go at creating it now, but if anyone wants to dive in with their input, feel free...

On the subject of posting attachments, what is the board's preferred way of exchanging pictures and files, would DropBox be acceptable ?
 
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,179
Members
453,021
Latest member
Justyna P

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
Back
Top