Use the contents of 3 other cells to dynamically assign a 4th cell's RGB background color

LokaPoka

New Member
Joined
Aug 30, 2012
Messages
6
This is my first-ever post to any forum so I hope I am following all the rules.

My question is actually the same as one previously posted on this forum, except that I am using Excel 2010, and the code posted for 2007 does not work for me. (The original poster said that he made some customizations, so perhaps the code also didn't work for him as-is.) I'm going to copy the text of the original poster, the answer that worked (?) for him, and a link to the original post.

Original post:
I'm wanting to dynamically set the RGB background color for cells in Column D to that of RGB values held in columns A,B,C. In other words, I am wanting to avoid achieving this by using Conditional Formatting with custom STYLES.

ie. A1=REDval, B1=GREENval, C1=BLUEval then cell backgroud color D1 = RGB(A1, B1, C1)

Example1:

A1=253, B1=205, C1=203
Then background RGB color of cell D1 to be automatically set to RGB(A1, B1, C1) = RGB(253, 205, 203)

Example2:

Background colour of Cell D1 = RGB("Value of A1","Value of B1","Value of C1")
Background colour of Cell D2 = RGB("Value of A2","Value of B2","Value of C2")
..
..
Background colour of Cell D65535 = RGB("Value of A65535","Value of B","Value of C65535")

I've tried looking for an answer but my keyword searches are either weak or inaccurate.
Any help or a solution would be most appreciated.

Original answer (for Excel 2007), and I apologize because I can't figure out how to make the code box (I searched the FAQ) but have done my best to simulate it for ease of reading:

In the worksheet where you want this colour banding to occur, right-click on the tab name at the bottom of Excel and select View Code. Paste the following into the code window which will open:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, cell As Range
Dim i As Long

Set rng = Intersect(Target, Range("A:C"))
If Not rng Is Nothing Then
On Error Resume Next
For Each cell In Target.Columns(1).Cells​
If Application.CountA(Range("A" & cell.Row & ":C" & cell.Row)) < 3 Or _​
Application.Count(Range("A" & cell.Row & ":C" & cell.Row)) < 3 Then GoTo next_row​
Cells(cell.Row, "D").Interior.Color = _ RGB(Cells(cell.Row, "A").Value, Cells(cell.Row, "B").Value, Cells(cell.Row, "C").Value)​
next_row:
Next cell​
End If
End Sub


Then go back into your sheet and enter some values in columns A:C. You will need a value in each of A:C on that particular row before the colour is applied in column D. If you already have a lot of values in A:C already, then select column A and go Ctrl+C>Ctrl+V to re-enter and thus apply the formatting to column D.

Link to original post:
http://www.mrexcel.com/forum/excel-...round-color-using-contents-3-other-cells.html



One thing I noticed is that the 2nd occurrence of "Application.CountA" does not have an "A", but adding the A does not make the code work for me. I get the error: "Compile error: Wrong number of arguments or invalid property assignment".

Thanks so much in advance!
~Katie
 

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
Try this...

Code:
[color=darkblue]Private[/color] [color=darkblue]Sub[/color] Worksheet_Change([color=darkblue]ByVal[/color] Target [color=darkblue]As[/color] Range)
    [color=darkblue]Dim[/color] r [color=darkblue]As[/color] Range
    [color=darkblue]If[/color] [color=darkblue]Not[/color] Intersect(Target, Range("A:C")) [color=darkblue]Is[/color] [color=darkblue]Nothing[/color] [color=darkblue]Then[/color]
        [color=darkblue]For[/color] [color=darkblue]Each[/color] r [color=darkblue]In[/color] Intersect(Target, Range("A:C")).Rows
            [color=darkblue]If[/color] Application.Count(Range("A" & r.Row).Resize(, 3)) = 3 And _
               Application.Max(Range("A" & r.Row).Resize(, 3)) <= 255 [color=darkblue]Then[/color]
                Cells(r.Row, "D").Interior.Color = _
                    RGB(Cells(r.Row, "A").Value, Cells(r.Row, "B").Value, Cells(r.Row, "C").Value)
            [color=darkblue]Else[/color]
                Cells(r.Row, "D").Interior.ColorIndex = xlNone
            [color=darkblue]End[/color] [color=darkblue]If[/color]
        [color=darkblue]Next[/color] r
    [color=darkblue]End[/color] [color=darkblue]If[/color]
End [color=darkblue]Sub[/color]
 
Upvote 0
Thanks! But I still get the same error. It highlights "RGB" on the line directly above "Else".

I am making the macro run by copying & pasting column A - is that the correct way or should I be doing something else? Also, this was originally a csv file, which I saved first as a .xlsx file and then as an .xlsm. I'm kind of grasping at straws here but thought it best to include as much info as possible just in case I'm making a novice error.
 
Upvote 0
I tried this on my Excel 2010 it worked the same as on my Excel 2003. I did have to make a new line after one of the underscores. Did you paste the code on the worksheet you are trying to use this on? Sheet1 (Sheet1)

PS. as a new user myself I find if I paste the code I want in the post/response then highlight it and click on the pound emblem (#) I get a code box.

Code:
Private Sub Worksheet_Change(ByVal Target As Range) 
Dim rng As Range, cell As Range 
Dim i As Long 

Set rng = Intersect(Target, Range("A:C")) 
If Not rng Is Nothing Then[INDENT]On Error Resume Next 
For Each cell In Target.Columns(1).Cells[/INDENT]
[INDENT=2]If Application.CountA(Range("A" & cell.Row & ":C" & cell.Row)) < 3 Or _[/INDENT]
[INDENT=3]Application.Count(Range("A" & cell.Row & ":C" & cell.Row)) < 3 Then GoTo next_row[/INDENT]
[INDENT=2]Cells(cell.Row, "D").Interior.Color = _ 'added newline here
RGB(Cells(cell.Row, "A").Value, Cells(cell.Row, "B").Value, Cells(cell.Row, "C").Value)[/INDENT]
next_row:[INDENT]Next cell[/INDENT]
End If 
End Sub
 
Upvote 0
Thanks! But I still get the same error. It highlights "RGB" on the line directly above "Else".

I am making the macro run by copying & pasting column A - is that the correct way or should I be doing something else? Also, this was originally a csv file, which I saved first as a .xlsx file and then as an .xlsm. I'm kind of grasping at straws here but thought it best to include as much info as possible just in case I'm making a novice error.

You can paste values.

Do you have any negative values or errors in Columns A, B, or C?
Does it error all the time no matter what values?
What is the error description?
 
Upvote 0
OrangePeddler -
Thanks for the tip about pasting code.

Regarding the new line: I pasted the code into the worksheet with my data, and still it gets stuck on RGB with the same error as before. I checked your code against what I had posted, and it turns out it was just my formatting error. The original post that I linked to is formatted the same as what you posted.

Next, because this code is working for you but not for me, I created a new worksheet, put some numbers in the first three columns, added the code, and... IT WORKED. Woohoo yippee horay! I just copied my "real' data into this new spreadsheet and it also worked! So, I have no idea what is wrong with the first spreadsheet but it is not affecting the new one.

I'm not sure how the original poster added the view of his data so I used Jing to create a screenshot which everyone can see here:
2012-08-30_1625

Thanks so much!!
 
Upvote 0
Thanks AlphaFrog. Apparently there was an issue with that specific Excel file because when I created a new one the original code worked, and it's beautiful :)
 
Upvote 0

Forum statistics

Threads
1,215,409
Messages
6,124,743
Members
449,186
Latest member
HBryant

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