epaezr
epaezr

Reputation: 474

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

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?

Upvotes: 14

Views: 50283

Answers (5)

gvesp
gvesp

Reputation: 1

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

Upvotes: 0

Paul
Paul

Reputation: 5924

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:

Excel sheet

Upvotes: 2

Excel Hero
Excel Hero

Reputation: 14754

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.

Upvotes: 1

Tim Williams
Tim Williams

Reputation: 166126

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)

Upvotes: 38

Gary&#39;s Student
Gary&#39;s Student

Reputation: 96753

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

enter image description here

Upvotes: 7

Related Questions