Reputation: 474
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
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
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:
Upvotes: 2
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
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
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
Upvotes: 7