Change a cell's background color dynamically according to a RGB value stored in other cells

Question

I'm trying to write a function in Excel that will set the background color of the active cell according to the values stored in other three cells (each of those three cells store a numeric value from 0 to 255, depending on the color R, G or B).

So the A1 cell is 150, the B1 cell is 220 and the C1 cell is 90 (that's RGB(150, 220, 90)). I need that the D1 cell's color is that RGB declared before (some kind of green), and also, if I place the function in D2, it will select the RGB stored in A2, B2 and C2, and so on...

Can this be achieved?

Governess

Please explain further. I don't get it. – Acaroid

You should be able to use code like this to set the colour of a cell SomeCell.Interior.Color = RGB(150, 220, 90) – Dyarchy

Answer 1

UDF version:

Function myRGB(r, g, b)

    Dim clr As Long, src As Range, sht As String, f, v

    If IsEmpty(r) Or IsEmpty(g) Or IsEmpty(b) Then
        clr = vbWhite
    Else
        clr = RGB(r, g, b)
    End If

    Set src = Application.ThisCell
    sht = src.Parent.Name

    f = "Changeit(""" & sht & """,""" & _
                  src.Address(False, False) & """," & clr & ")"
    src.Parent.Evaluate f
    myRGB = ""
End Function

Sub ChangeIt(sht, c, clr As Long)
    ThisWorkbook.Sheets(sht).Range(c).Interior.Color = clr
End Sub

Usage (entered in D1):

=myRGB(A1,B1,C1)

Marienbad

Never thought of calling a sub from the function to do the change, NICE. – Cornelison

Beautiful. This technique can be used to achieve many other things as well. – Awesome

This is just what I needed!! Thank you Tim! – Governess

TIM, User Defined Function, given by you is an useful tool, generated a 3000 pixel RGB values into an image. Thanks. – Centrosymmetric

@TimWilliams I'm going a bit crazy trying to adapt this to take a text value. i.e. =G4 & "hi" & myRGB(255,0,0,"Hello I am Red") & myRGB(0,0,255,"Hello I am Blue") & " " & H4 – Overstreet

What is the end result you want though? – Marienbad

Answer 2

In D1 enter:

=A1 & "," & B1 & "," & C1

and in the worksheet code area, enter the following event macro:

Private Sub Worksheet_Calculate()
   Range("D1").Interior.Color = RGB(Range("A1"), Range("B1"), Range("C1"))
End Sub

Sheasheaf

That does not seem very useful... with hardcoded ranges – Acaroid

@ExcelHero The code was "designed" with the question in mind. – Inpatient

Even if those three cells are actually all the OP wants, your solution is not a good design. Why run this every single time the worksheet calculates? The task prescribed should be kept to an absolute minimum number of times executed. – Acaroid

@Gary'sStudent My apologies. Reading it back now I see it was quite a bit harsher than I intended. – Acaroid

@Gary'sStudent, your code works perfectly for cell D1! Is there a way to make this code work in any given cell, drawing the RGB data from any given group of three cells? Thanks – Azral

Answer 3

I'd like to expand on Tim Williams terrific answer. I needed to be able to show a hex value in my cells based on other cells. I also want the font set to either white or black because of this. So I modified the function as follows:

Function hexColor(r, g, b)

    Dim bclr As Long, fclr As Long, src As Range, sht As String, f, v

     If IsEmpty(r) Or IsEmpty(g) Or IsEmpty(b) Then
        bclr = vbWhite
        fclr = vbBlack
    Else
        bclr = RGB(r, g, b)
        If ((r * 0.299) + (g * 0.587) + (b * 0.114) > 186) Then
            fclr = vbBlack
        Else
            fclr = vbWhite
        End If
    End If

    Set src = Application.ThisCell
    sht = src.Parent.Name

    f = "Changeit(""" & sht & """,""" & _
                  src.Address(False, False) & """," & bclr & "," & fclr & ")"
    src.Parent.Evaluate f

    Dim hr As String, hg As String, hb As String

    hr = Right("0" & Hex(r), 2)
    hg = Right("0" & Hex(g), 2)
    hb = Right("0" & Hex(b), 2)

    hexColor = "#" & hr & hg & hb
End Function

Sub ChangeIt(sht, c, bclr As Long, fclr As Long)
    ThisWorkbook.Sheets(sht).Range(c).Interior.Color = bclr
    ThisWorkbook.Sheets(sht).Range(c).Font.Color = fclr
End Sub

This means I can enter the following two cell values: =hexColor(185,201,225) and =hexColor(115,146,198) and get the following result:

Csch

Answer 4

Assuming you would want this to work with the entire columns instead of just row 1, here is the VBA procedure for the worksheet's code module:

Private Sub Worksheet_Change(ByVal Target As Range)

    With Target
        If .Count = 1 Then
            If .Column < 4 Then
                Cells(.Row, 4).Interior.Color = RGB(Cells(.Row, 1), Cells(.Row, 2), Cells(.Row, 3))
            End If
        End If
    End With

End Sub

Note: I do not know what you mean by the following and so have not addressed it: and also, if I place the function in D2, it will select the RGB stored in A2, B2 and C2.

Acaroid

EH, I guess the answer of Tim addressed the pending issue. A UDF that the user can place anywhere. – Awesome

@Awesome Maybe. Still don't know for sure what OP meant. – Acaroid

Small typo code to set color - last value (blue) has a period before "Cells(.Row, 3)" Should be: Cells(.Row, 4).Interior.Color = RGB(Cells(.Row, 1), Cells(.Row, 2), Cells(.Row, 3)) – Subduct

Answer 5

The manual page for the "ThisCell" property includes this warning: "Users should not access properties or methods on the Range object when inside the user-defined function." The UDF by Tim Williams ignores the warning and circumvents it by using the "Evaluate" method, so that the color is changed immediately, as the UDF is being executed.

The manual page, after the warning, has this recommendation: "Users can cache the Range object for later use and perform additional actions when the recalculation is finished".

Here is a modified version of Tim Williams' UDF that achieves the same result but abides by the warning and follows the recommendation. It schedules the execution of the ChangeIt sub to occur "Now", which places it at the bottom of the queue to be executed after the recalculation is finished.

Dim clr As Long, src As Range
Function myRGB(r, g, b)

    Dim f

    If IsEmpty(r) Or IsEmpty(g) Or IsEmpty(b) Then
        clr = vbWhite
    Else
        clr = RGB(r, g, b)
    End If

    Set src = Application.ThisCell

    f = "Application.OnTime Now, Changeit()"
    src.Parent.Evaluate f
    myRGB = ""
End Function

Sub ChangeIt()
    src.Interior.Color = clr
End Sub

Acquire