VBA change shape color based on cell value

noelmus

Board Regular
Joined
Dec 30, 2018
Messages
105
Hi
I am using a code so that the shape changes the color when a cell value is changed.
My problem is that cell J24 is changing as a result of a formula recalculating. So what I have to change in my code shown below to make it work?
I prefer that the code will work for 2 shapes since I need to add another shape.

Thanks in advance

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("J24")) Is Nothing Then Exit Sub
If IsNumeric(Target.Value) Then
If Target.Value < 80000 Then
ActiveSheet.Shapes("LevelA").Fill.ForeColor.RGB = vbRed
ElseIf Target.Value >= 80000 And Target.Value < 400000 Then
ActiveSheet.Shapes("LevelA").Fill.ForeColor.RGB = vbYellow
Else
ActiveSheet.Shapes("LevelA").Fill.ForeColor.RGB = vbGreen
End If
End If
End Sub
 
I'm not sure what you mean. Can you give me an example?
 
Upvote 0

Excel Facts

What is the shortcut key for Format Selection?
Ctrl+1 (the number one) will open the Format dialog for whatever is selected.
Try:
Code:
Private Sub Worksheet_Calculate()
    Static LastValueJ, LastValueH
    Dim shp As Shape
    With Range("j24")
        If LastValueJ <> .Value Then
            AdjustTank .Value, "A"
            LastValueJ = .Value
        End If
    End With
    With Range("H24")
        If LastValueH <> .Value Then
            AdjustTank .Value, "B"
            LastValueH = .Value
        End If
    End With
    For Each shp In ActiveSheet.Shapes
        If shp.Name = "TankA" Then
            If IsNumeric(Range("J24")) Then
                If Range("J24").Value < 80000 Then
                   shp.Fill.ForeColor.RGB = vbRed
                ElseIf Range("J24").Value >= 80000 And Range("J24").Value < 400000 Then
                   shp.Fill.ForeColor.RGB = vbYellow
                Else
                    shp.Fill.ForeColor.RGB = vbGreen
                End If
            End If
        ElseIf shp.Name = "TankB" Then
            If IsNumeric(Range("H24")) Then
                If Range("H24").Value < 80000 Then
                   shp.Fill.ForeColor.RGB = vbRed
                ElseIf Range("H24").Value >= 80000 And Range("H24").Value < 400000 Then
                   shp.Fill.ForeColor.RGB = vbYellow
                Else
                    shp.Fill.ForeColor.RGB = vbGreen
                End If
            End If
        End If
    Next shp
End Sub
 
Upvote 0
Sorry mumps but it didn't work. Tanks still shown with full fill when the value is not full.
Thanks
 
Upvote 0
Click here to download your file. Please let me know how it works out.
 
Upvote 0

Forum statistics

Threads
1,214,591
Messages
6,120,427
Members
448,961
Latest member
nzskater

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top