I need a macro that change automatically the color of a cell

Question

I need to change the color of same cell on the base of the value contained in it.

I wrote this code and it that work:

Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target, Range("G47")) Is Nothing Then
        With Target.Interior
            Select Case Target.Value            
                Case 0: .Color = RGB(Range("F4"), Range("G4"), Range("H4"))
                Case 1 To 2: .Color = RGB(220, 0, 0)
                Case 3 To 4: .Color = RGB(255, 0, 0)
                Case 5 To 6: .Color = RGB(255, 102, 0)
                Case 7 To 8: .Color = RGB(255, 165, 0)
                Case 9 To 10: .Color = RGB(255, 215, 0)

                Case 11 To 12: .Color = RGB(255, 255, 150)
                Case 13 To 14: .Color = RGB(180, 255, 102)
                Case 15 To 16: .Color = RGB(102, 255, 102)
                Case 17 To 18: .Color = RGB(51, 204, 51)

                Case 19 To 20: .Color = RGB(0, 140, 0)
                Case Is > 20: .Color = RGB(0, 90, 0)

            End Select
        End With
    End If
End Sub

The problem is that it doesn't change automatically the color. Then if the value in this cell depend on a function and I change the values used by the function, even if in the cell the value change, the color remain the same. To make chenge the color I have to press each time enter. I would like that it works like a conditional formatting.

Answer 1

I believe your code is not working because the cell you are changing is linked through a formula with the cell you want to format. If this is the case you can follow the below steps

Make you color changing function as a separate function and add it in a module and name it for example as formatColor(Range)

Add Sheet references in this function so that it works on the correct sheet

Call this function in your Worksheet_Change(ByVal Target As Range) as

Private Sub Worksheet_Change(ByVal Target As Range)
    Call formatColor(Target)
End Sub

Now if the source data is in another sheet call this function from Worksheet_Change of that sheet

Private Sub Worksheet_Change(ByVal Target As Range)

  range_list = Target.Dependents.Address
  range_array = Split(range_list, ",")
    For Each r In range_array
      Call formatColor(r)
    Next
 End Sub

You have to insert your intersect check on top of that. If it is in the same sheet you can modify the code accordingly

If Target.Dependents.Address is returning a range you have to make a loop to call the function on all cells.