Change Shape Color Based On Cell Value In Excel

[RedllowFenix]

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.

 

[mumps]

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

What are the names of the other 9 shapes?

 

[RedllowFenix]

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

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

 

[mumps]

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

Try:

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

 

[RedllowFenix]

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

Try:

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]

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?

 

[RedllowFenix]

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]

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.