I am trying to get write a simple function one can call from a cell that would return if the background of a given cell has a specific background color.
This function works as expected when called from a sub-routine, but fails when called from the worksheet. At the line
IntColor = Cell.DisplayFormat.Interior.Color
Here is all of the code
Option Explicit
Public Function GetCellRGB(Rng As Range) As Integer()
Dim Result(1 To 3) As Integer
Dim Cell As Range
Set Cell = Rng.Cells(1, 1)
Dim IntColor As Integer
' when called from worksheet, function exits here with a #VALUE error
IntColor = Cell.DisplayFormat.Interior.Color
Result(1) = IntColor Mod 256 ' red
Result(2) = IntColor \ 256 Mod 256 ' green
Result(3) = IntColor \ 65536 Mod 256 ' blue
GetCellRGB = Result
End Function
Public Function IsColor(Rng As Range, R As Integer, G As Integer, B As Integer) As Boolean
Dim Vals() As Integer
Vals = GetCellRGB(Rng)
If R = Vals(1) And G = Vals(2) And B = Vals(3) Then
IsColor = True
Else
IsColor = False
End If
End Function
' This works as expected
Sub ColorTest()
Dim Rng As Range
Set Rng = ThisWorkbook.ActiveSheet.Range("A1")
Debug.Print IsColor(Rng, 255, 0, 0)
End Sub

Here's a workaround to the "DisplayFormat not available in a UDF" problem.
It uses Evaluate to side-step the UDF context
Public Function DFColor(addr)
DFColor = Range(addr).DisplayFormat.Interior.Color
End Function
Function CFColorMatches(rng As Range, R As Long, G As Long, B As Long)
CFColorMatches = (rng.Parent.Evaluate("DFColor(""" & rng.Address & """)") = RGB(R, G, B))
End Function
Note also you really don't need all that RGB-related code
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With