Change Shape Color Based On Cell Value In Excel

RedllowFenix

New Member
Joined
Oct 5, 2017
Messages
16
Hi there!

I want to do dynamic the shape color based on cell value (percentages) where:

Value (%) > 0 [Green]
Value (%) < 0 [Red]

I could do it with the following VBA code (thanks to Extendoffice page) but JUST FOR ONE SHAPE:

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, Range("K23")) Is Nothing Then Exit Sub
If IsNumeric(Target.Value) Then
If Target.Value < 0 Then
ActiveSheet.Shapes("Rounded Rectangle 114").Fill.ForeColor.RGB = RGB(232, 102, 126)
ElseIf Target.Value > 0 Then
ActiveSheet.Shapes("Rounded Rectangle 114").Fill.ForeColor.RGB = RGB(118, 184, 117)
End If
End If
End Sub

The issue is that I have 10 more shapes to which I want to do exactly the same and I couldn't do it because it only works just with the first shape.

How to include in the code the other cell values i.e L23, M23, N23...?

Thanks in advance.
 

Excel Facts

What does custom number format of ;;; mean?
Three semi-colons will hide the value in the cell. Although most people use white font instead.

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
10,307
Re: HELP! Change Shape Color Based On Cell Value In Excel

What are the names of the other 9 shapes?
 

RedllowFenix

New Member
Joined
Oct 5, 2017
Messages
16
Re: HELP! Change Shape Color Based On Cell Value In Excel

Rounded Rectangle 117, Rounded Rectangle 118 and so on....
 

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
10,307
Re: HELP! Change Shape Color Based On Cell Value In Excel

Try:
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("K:T")) Is Nothing Then Exit Sub
    Dim x As Long
    If IsNumeric(Target.Value) Then
        Select Case Target.Column
            Case Is = 11
                If Target.Value < 0 Then
                    ActiveSheet.Shapes("Rounded Rectangle 114").Fill.ForeColor.RGB = RGB(232, 102, 126)
                ElseIf Target.Value > 0 Then
                    ActiveSheet.Shapes("Rounded Rectangle 114").Fill.ForeColor.RGB = RGB(118, 184, 117)
                End If
        End Select
        For x = 12 To 20
            Select Case Target.Column
                Case Is = x
                    If Target.Value < 0 Then
                        ActiveSheet.Shapes("Rounded Rectangle " & x + 105).Fill.ForeColor.RGB = RGB(232, 102, 126)
                    ElseIf Target.Value > 0 Then
                        ActiveSheet.Shapes("Rounded Rectangle " & x + 105).Fill.ForeColor.RGB = RGB(118, 184, 117)
                    End If
            End Select
        Next x
    End If
End Sub
 
Last edited:

RedllowFenix

New Member
Joined
Oct 5, 2017
Messages
16

ADVERTISEMENT

Re: HELP! Change Shape Color Based On Cell Value In Excel

Try:
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("K:T")) Is Nothing Then Exit Sub
    Dim x As Long
    If IsNumeric(Target.Value) Then
        Select Case Target.Column
            Case Is = 11
                If Target.Value < 0 Then
                    ActiveSheet.Shapes("Rounded Rectangle 114").Fill.ForeColor.RGB = RGB(232, 102, 126)
                ElseIf Target.Value > 0 Then
                    ActiveSheet.Shapes("Rounded Rectangle 114").Fill.ForeColor.RGB = RGB(118, 184, 117)
                End If
        End Select
        For x = 12 To 20
            Select Case Target.Column
                Case Is = x
                    If Target.Value < 0 Then
                        ActiveSheet.Shapes("Rounded Rectangle " & x + 105).Fill.ForeColor.RGB = RGB(232, 102, 126)
                    ElseIf Target.Value > 0 Then
                        ActiveSheet.Shapes("Rounded Rectangle " & x + 105).Fill.ForeColor.RGB = RGB(118, 184, 117)
                    End If
            End Select
        Next x
    End If
End Sub

Thanks mumps! I just figured out with the following code:
Private Sub Worksheet_Change(ByVal Target As Range)


'General data


If Not Intersect(Target, Range("C36")) Is Nothing Then
Me.Shapes("Rounded Rectangle 86").Select
With Range("C36")
If .Value > 0.05 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(118, 184, 117)
ElseIf .Value >= -0.05 And .Value <= 0.05 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(246, 200, 102)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(232, 102, 126)
End If
.Select
End With
End If

If Not Intersect(Target, Range("D36")) Is Nothing Then
Me.Shapes("Rounded Rectangle 92").Select
With Range("D36")
If .Value > 0.05 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(118, 184, 117)
ElseIf .Value >= -0.05 And .Value <= 0.05 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(246, 200, 102)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(232, 102, 126)
End If
.Select
End With
End If

If Not Intersect(Target, Range("E36")) Is Nothing Then
Me.Shapes("Rounded Rectangle 98").Select
With Range("E36")
If .Value > 0.05 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(118, 184, 117)
ElseIf .Value >= -0.05 And .Value <= 0.05 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(246, 200, 102)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(232, 102, 126)
End If
.Select
End With
End If
If Not Intersect(Target, Range("F36")) Is Nothing Then
Me.Shapes("Rounded Rectangle 104").Select
With Range("F36")
If .Value > 0.05 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(118, 184, 117)
ElseIf .Value >= -0.05 And .Value <= 0.05 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(246, 200, 102)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(232, 102, 126)
End If
.Select
End With
End If
End sub

But what if I need that the "If.value" reference no a specific number but another cell value. Example:

If .Value > "C32" Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(118, 184, 117)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(232, 102, 126)
End If

I couldn't do it...

Appreciate your help!
 

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
10,307
Re: HELP! Change Shape Color Based On Cell Value In Excel

What are the actual reference cells for the If.Value and ElseIf.Value statements? Are they the same for all the shapes?
 
Last edited:

RedllowFenix

New Member
Joined
Oct 5, 2017
Messages
16
Re: HELP! Change Shape Color Based On Cell Value In Excel

What are the actual reference cells for the If.Value and ElseIf.Value statements? Are they the same for all the shapes?

Same Row but different column. Six of them.
 

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
10,307
Re: HELP! Change Shape Color Based On Cell Value In Excel

That doesn't tell me which cells they are in. Please be specific for each shape and for each If.Value and ElseIf.Value statements.
 

Watch MrExcel Video

Forum statistics

Threads
1,129,921
Messages
5,639,004
Members
417,062
Latest member
CM214

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
Top