Change Cell Color inside Formula

[NamssoB]

I need to set a cells background color (and potentially the text color), but without using Conditional Formatting.

Column G contains a word (Pending, Complete, Scheduled)
Column H contains a dollar value
Column I is what I am manipulating.

The current formula in Column I is as follows:

=IF(G30="Pending",H30,IF(G30="Complete",H30,""))

This is super simple - based on what is in G, it copies the dollar value from H to I. What I need to add is that if G30="Pending", I also want to COLOR cell I to be a light yellow background.

1) Is there already a way to do this?
2) If NO, and I use a VBA Function, how do I structure the VBA function so that it works for all cells in Column I, without hard coding a specific cell?

Column I Formula:

=IF(G30="Pending",SetColor(H30,"Yellow"),IF(G30="Complete",H30,""))

Function Code:

Function SetColor(strColor as String, dblValue as Double)
   Cell.Color.Background=strColor
   Cell.Value = dblValue
End Function

I figured that I have to also populate the value into the cell because you can't perform two things inside the True leg of the IF statement. Or am I missing something there also?

 

[Scott T]

As far as I know you can not use a UDF to set formatting like cell color. Why can you not use conditional formatting? you could use a change event something like

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("I30:I37")) Is Nothing Then
    If UCase(Target.Offset(0, -2)) = "PENDING" Then
        Target.Interior.ColorIndex = 6
    End If
End If
End Sub

 

[Jaafar Tribak]

I have used this API trick to change the cell color from within the UDF .

Put this code in a Standard Module :

Option Explicit

[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  VBA7 Then
    Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
    Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
    Declare PtrSafe Function GlobalAddAtom Lib "kernel32" Alias "GlobalAddAtomA" (ByVal lpString As String) As Integer
    Declare PtrSafe Function GlobalGetAtomName Lib "kernel32" Alias "GlobalGetAtomNameA" (ByVal nAtom As Integer, ByVal lpBuffer As String, ByVal nSize As Long) As Long
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 
    Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
    Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
    Declare Function GlobalAddAtom Lib "kernel32" Alias "GlobalAddAtomA" (ByVal lpString As String) As Integer
    Declare Function GlobalGetAtomName Lib "kernel32" Alias "GlobalGetAtomNameA" (ByVal nAtom As Integer, ByVal lpBuffer As String, ByVal nSize As Long) As Long
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If

Public Function SetColor(ByVal Value As Variant, ByVal BackGroundColor As String) As Variant
     SetTimer Application.hwnd, GlobalAddAtom(Application.Caller.Address(External:=True) & "*" & BackGroundColor), 0, AddressOf ChangeColor
    SetColor = Value
End Function

Sub ChangeColor(ByVal hwnd As Long, ByVal uMsg As Long, ByVal nIDEvent As Long, ByVal dwTimer As Long)
    Dim sBuffer As String, lRet As Long, lColorIndex As Long
 
    On Error Resume Next
    KillTimer hwnd, nIDEvent
    sBuffer = Space(256)
    lRet = GlobalGetAtomName(nIDEvent, sBuffer, Len(sBuffer))
    sBuffer = Left(sBuffer, lRet)
    Select Case UCase(Split(sBuffer, "*")(1))
        Case "YELLOW"
            lColorIndex = 6
        Case "GREEN"
            lColorIndex = 14
        Case "BLUE"
            lColorIndex = 23
        Case "RED"
            lColorIndex = 3
        Case "CYAN"
            lColorIndex = 33
        Case "MAGENTA"
            lColorIndex = 47
        Case "NONE"
            lColorIndex = xlColorIndexNone
    End Select
    Range(Split(sBuffer, "*")(0)).Interior.ColorIndex = lColorIndex
End Sub

You would then use the worksheet formula in Column I as follows :

=(IF(G30="Pending",SetColor(H30,"Yellow"),IF(G30="Complete",SetColor(H30;"None"),SetColor("","None"))))

The UDF is flexible as to the colors you can use other than yellow.

You could for example set the following colors :

Red for "Pending"
Yellow for "Scheduled"
Green for "Complete"

with this formula :

=(IF(G30="Pending",SetColor(H30;"Red"),IF(G30="Complete",SetColor(H30;"Green"),SetColor("","Yellow"))))