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

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result
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,215,328
Messages
6,124,299
Members
449,149
Latest member
mwdbActuary

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