Colour an object based on cell content

[JonesyUK]

Hi - Thanks for your advice.

I have a circle object on an Excel spreadsheet(I used "Insert", "Shapes" to put it there).

I would like to change the colour of the circle object based on the contents of cell A1.

Cell A1 will be "Red", "Yellow" or "Green".

If I type "Green" into cell A1, then I would like the circle object to change to green.
If I type "Yellow" into cell A1, then I would like the circle object to change to yellow....

etc. etc.

Hope this makes sense, and again, thanks for your response.
C

 

[Andrew Poulsom]

You would need to use the Worksheet_Change event procedure to do that. The macro recorder will get you started, but post back if you are still stuck.

 

[JonesyUK]

Hi Andrew - sorry, but you lost me with "use the Worksheet_Change event"...

Maybe list all the steps? I am using Excel 2007.

Thanks.
C

 

[Andrew Poulsom]

Right click the worksheet tab and choose View Code. Paste this into the window on the right:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address <> "$A$1" Then Exit Sub
    With Shapes("Oval 1").Fill
        Select Case Target.Value
            Case "Red"
                .Visible = msoTrue
                .ForeColor.SchemeColor = 10
            Case "Yellow"
                .Visible = msoTrue
                .ForeColor.SchemeColor = 13
            Case "Green"
                .Visible = msoTrue
                .ForeColor.SchemeColor = 17
            Case Else
                .Visible = msoFalse
        End Select
    End With
End Sub

The code assumes your circle is named "Oval 1" - change to suit. Close the Vsual Basic Editor and try it out.

 

[JonesyUK]

Hi Andrew, it works like a dream!

Thanks a million for the quick response.

Clint

 

[JonesyUK]

Okay, this worked great, but I should probably have explained the entire exercise:

I have about 50 graphs on the sheet called "LINE_PPT". Each graph will have an object(a little circle) placed on it like a little traffic light indicator, which should change colour based on the value assigned to it. The values are on the sheet called "TREND".

So on Sheet = "TREND", I have the following data:

"Col M" "Col N"
Oval 1 30
Oval 2 20
Oval 3 10
Oval 4 30
Oval 5 10
Oval 6 10
Oval 7 10
Oval 8 30
Oval 9 30
Oval 10 10
Oval 11 20
Oval 12 10
Oval 13 10
Oval 14 30
Oval 15 10
Oval 16 30
Oval 17 10

etc. etc. all the way to Oval 50...

How do I change this macro so that the target cell $A$1 becomes

SHEET NAME = "TREND"
CELL = "M4" which is oval 1

And loops through all the objects, changing their colours...

Hope this makes sense...

Thanks as always,
C

 

[Andrew Poulsom]

What determines the colour?

 

[JonesyUK]

Hi Andrew, the colour is determined by a number 10, 20, or 30.

So on the sheet named "Trend", cells M4 to M20+ will have the oval name and the value which determines the colour:

10 20 30
Green Red Amber

Oval 1 = 30
Oval 2 = 20
Oval 3 = 10 etc. etc...

Thanks...
Clint

 

[JonesyUK]

Also, these are the colours I'm using:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$A$1" Then Exit Sub
With Shapes("Oval 1").Fill
Select Case Target.Value
Case 30
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 0, 0)
Case 20
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 192, 0)
Case 10
.Visible = msoTrue
.ForeColor.RGB = RGB(146, 208, 80)
Case Else
.Visible = msoFalse
End Select
End With
End Sub

 

[Andrew Poulsom]

Try (in the Module for the TREND worksheet):

Private Sub Worksheet_Change(ByVal Target As Range)
    If Application.Intersect(Target, Range("N4:N53")) Is Nothing Then Exit Sub
    If Target.Count > 1 Then Exit Sub
    With Shapes(Target.Offset(, -1).Value).Fill
        Select Case Target.Value
            Case 30
                .Visible = msoTrue
                .ForeColor.RGB = RGB(255, 0, 0)
            Case 20
                .Visible = msoTrue
                .ForeColor.RGB = RGB(255, 192, 0)
            Case 10
                .Visible = msoTrue
                .ForeColor.RGB = RGB(146, 208, 80)
            Case Else
                .Visible = msoFalse
        End Select
    End With
End Sub