Changing colour of autoshapes

colmcg

Board Regular
Joined
Jul 2, 2004
Messages
101
Is it possible to conditionally format the colour of an autoshape depending on the value in a cell?

Searching this forum I have managed to link an autoshape to display the cell value (add text, click formula bar, =cell ref) but I would also like the autoshapes colour to change based on the value in the cell. e.g. If cell value is between 5% & 10% then colour green, if cell value is between 11% and 15% then blue etc.

I will probably have about 50 autoshapes that I wish to apply this to. Also there will be different kinds of autoshapes - e.g. squares, rectangles, circles.

Can anyone help?
 

Some videos you may like

Excel Facts

What is the shortcut key for Format Selection?
Ctrl+1 (the number one) will open the Format dialog for whatever is selected.

erik.van.geit

MrExcel MVP
Joined
Feb 1, 2003
Messages
17,832
Hi,

you could use something like
Code:
Set Sh = ActiveSheet.Shapes("whatever")
    Select Case Range("A1")
    Case 0 to .15 '0 to 15%
    Sh.Fill.ForeColor.SchemeColor = 51
    Case .15 to .25
    'etcetera
    End Select
so, take a look at "Select Case"
If you need more help, it would be good to show the code you are using.

kind regards,
Erik
 

colmcg

Board Regular
Joined
Jul 2, 2004
Messages
101
Erik, thanks for your reply.

I don't actually have any code yet, in fact I haven't even set up a spreadsheet yet. I was posting to find out if it was possible to change an autoshapes colour using a value in a cell. If it was possible I was then going to try and create a spreadsheet.

Since posting I have done a few further searches and it seems VBA is the only way to achieve what I want. I have looked at a couple of other posts but cant adapt them for my project.

VBA is not one of my strong points, beginner would best describe my ability.

I am now having a look at Select Case but would be grateful for any further advice.

Regards

Colin
 

Greg Truby

MrExcel MVP
Joined
Jun 19, 2002
Messages
10,014
Colin,

You may also find this thread helpful. (Or maybe just confusing?) It describes how to use VBA to create a scale of colors that blend from red to blue in your pallet. Sorta makes assigning colors based on value a little easier.<hr />

Heya, Erik! :biggrin:
 

colmcg

Board Regular
Joined
Jul 2, 2004
Messages
101

ADVERTISEMENT

Greg, you were right I found the thread confusing (my limited VBA to blame). Thanks for looking at the post.

What I have in mind is creating a floor plan using autoshapes. I have managed to get a cell value appear in an autoshape but thought it would be visually more appealing if I could get an autoshapes colour to change to represent different values.

For example if the cell value was between 1 & 5 then the autoshape would turn red, if the cell value was between 6 & 10 then a different colour, between 11 & 15 then a different colour, etc, etc.

I haven't created a spreadsheet yet as I needed to find out if it was possible to do this. Armed with this information I was then going to tackle setting up a spreadsheet.

I would be grateful for any tips to point me in the right direction. I must warn you my VBA knowledge is minimal (but always looking to learn!)

Thanks in advance

Colin
 

erik.van.geit

MrExcel MVP
Joined
Feb 1, 2003
Messages
17,832
I am now having a look at Select Case but would be grateful for any further advice.
did you try the codesnippet I gave you
create a shape, name it "whatever" and run the code, you received earlier

use the macrorecorder to learn more about syntax ...
don't forget the helpfiles :)

I changed the code according to your last post
Code:
Set Sh = ActiveSheet.Shapes("whatever") 
    Select Case Range("A1") 
    Case 1 to 5 
    Sh.Fill.ForeColor.SchemeColor = 51 
    Case 6 to 10
    'etcetera 
    End Select
if the "number-ranges" are regular like in your last post (1 to 5, 6 to 10, ...) there might be other options

kind regards,
Erik
 

Greg Truby

MrExcel MVP
Joined
Jun 19, 2002
Messages
10,014

ADVERTISEMENT

How are you assigning the values to the autoshapes? By code? Or by hand? How can you know "this cell is linked to that shape". I'm not seeing a property of shape objects that will return a shape's "formula".
 

colmcg

Board Regular
Joined
Jul 2, 2004
Messages
101
Erik, Greg.

Thank you both for your replys. Sorry it's taken so long to re-post but I've been at work and I don't have internet access there.

Greg, I'm not sure if the cell is 'linked' to the autoshape. What I managed to achieve was display the value of A1 in the autoshape by clicking 'add text' and then reference the cell.

Erik, both your codes seem to achieve what I want. By running your code I've managed to change an autoshapes colour using different values in A1. I can sort of see how the codes work and am going to tinker about with it to see if I can expand it. Unfortunately I'm at work again tomorrow but will let you know how I get on by the end of the week. I may need further help as VBA knowledge is pretty basic. Thanks for your assistance so far.

Regards

Colin
 

colmcg

Board Regular
Joined
Jul 2, 2004
Messages
101
Erik,

I named my autoshapes Pos01 to Pos20 and I have now got the following piece of code which works (thankyou very much). However it seems a bit longwinded. Is there a way to shorten this code by looping through each autoshape rather than selecting each one in turn?

CODE:
Sub RankAutoShapes()

'Colours AutoShapes according to Ranking (1 - 20)

Set Sh = ActiveSheet.Shapes("Pos01")
Select Case Range("A1")
Case 0
Sh.Fill.ForeColor.SchemeColor = 1 'White
Case 1 To 5
Sh.Fill.ForeColor.SchemeColor = 2 'Red
Case 6 To 10
Sh.Fill.ForeColor.SchemeColor = 51 'Orange
Case 11 To 15
Sh.Fill.ForeColor.SchemeColor = 27 'Light Blue
Case 16 To 20
Sh.Fill.ForeColor.SchemeColor = 4 'Blue
End Select
Set Sh = ActiveSheet.Shapes("Pos02")
Select Case Range("A2")
Case 0
Sh.Fill.ForeColor.SchemeColor = 1 'White
Case 1 To 5
Sh.Fill.ForeColor.SchemeColor = 2 'Red
Case 6 To 10
Sh.Fill.ForeColor.SchemeColor = 51 'Orange
Case 11 To 15
Sh.Fill.ForeColor.SchemeColor = 27 'Light Blue
Case 16 To 20
Sh.Fill.ForeColor.SchemeColor = 4 'Blue
End Select
Set Sh = ActiveSheet.Shapes("Pos03")
Select Case Range("A3")
Case 0
Sh.Fill.ForeColor.SchemeColor = 1 'White
Case 1 To 5
Sh.Fill.ForeColor.SchemeColor = 2 'Red
Case 6 To 10
Sh.Fill.ForeColor.SchemeColor = 51 'Orange
Case 11 To 15
Sh.Fill.ForeColor.SchemeColor = 27 'Light Blue
Case 16 To 20
Sh.Fill.ForeColor.SchemeColor = 4 'Blue
End Select
Set Sh = ActiveSheet.Shapes("Pos04")
Select Case Range("A4")
Case 0
Sh.Fill.ForeColor.SchemeColor = 1 'White
Case 1 To 5
Sh.Fill.ForeColor.SchemeColor = 2 'Red
Case 6 To 10
Sh.Fill.ForeColor.SchemeColor = 51 'Orange
Case 11 To 15
Sh.Fill.ForeColor.SchemeColor = 27 'Light Blue
Case 16 To 20
Sh.Fill.ForeColor.SchemeColor = 4 'Blue
End Select
Set Sh = ActiveSheet.Shapes("Pos05")
Select Case Range("A05")
Case 0
Sh.Fill.ForeColor.SchemeColor = 1 'White
Case 1 To 5
Sh.Fill.ForeColor.SchemeColor = 2 'Red
Case 6 To 10
Sh.Fill.ForeColor.SchemeColor = 51 'Orange
Case 11 To 15
Sh.Fill.ForeColor.SchemeColor = 27 'Light Blue
Case 16 To 20
Sh.Fill.ForeColor.SchemeColor = 4 'Blue
End Select
Set Sh = ActiveSheet.Shapes("Pos06")
Select Case Range("A6")
Case 0
Sh.Fill.ForeColor.SchemeColor = 1 'White
Case 1 To 5
Sh.Fill.ForeColor.SchemeColor = 2 'Red
Case 6 To 10
Sh.Fill.ForeColor.SchemeColor = 51 'Orange
Case 11 To 15
Sh.Fill.ForeColor.SchemeColor = 27 'Light Blue
Case 16 To 20
Sh.Fill.ForeColor.SchemeColor = 4 'Blue
End Select
Set Sh = ActiveSheet.Shapes("Pos07")
Select Case Range("A7")
Case 0
Sh.Fill.ForeColor.SchemeColor = 1 'White
Case 1 To 5
Sh.Fill.ForeColor.SchemeColor = 2 'Red
Case 6 To 10
Sh.Fill.ForeColor.SchemeColor = 51 'Orange
Case 11 To 15
Sh.Fill.ForeColor.SchemeColor = 27 'Light Blue
Case 16 To 20
Sh.Fill.ForeColor.SchemeColor = 4 'Blue
End Select
Set Sh = ActiveSheet.Shapes("Pos08")
Select Case Range("A8")
Case 0
Sh.Fill.ForeColor.SchemeColor = 1 'White
Case 1 To 5
Sh.Fill.ForeColor.SchemeColor = 2 'Red
Case 6 To 10
Sh.Fill.ForeColor.SchemeColor = 51 'Orange
Case 11 To 15
Sh.Fill.ForeColor.SchemeColor = 27 'Light Blue
Case 16 To 20
Sh.Fill.ForeColor.SchemeColor = 4 'Blue
End Select
Set Sh = ActiveSheet.Shapes("Pos09")
Select Case Range("A9")
Case 0
Sh.Fill.ForeColor.SchemeColor = 1 'White
Case 1 To 5
Sh.Fill.ForeColor.SchemeColor = 2 'Red
Case 6 To 10
Sh.Fill.ForeColor.SchemeColor = 51 'Orange
Case 11 To 15
Sh.Fill.ForeColor.SchemeColor = 27 'Light Blue
Case 16 To 20
Sh.Fill.ForeColor.SchemeColor = 4 'Blue
End Select
Set Sh = ActiveSheet.Shapes("Pos10")
Select Case Range("A10")
Case 0
Sh.Fill.ForeColor.SchemeColor = 1 'White
Case 1 To 5
Sh.Fill.ForeColor.SchemeColor = 2 'Red
Case 6 To 10
Sh.Fill.ForeColor.SchemeColor = 51 'Orange
Case 11 To 15
Sh.Fill.ForeColor.SchemeColor = 27 'Light Blue
Case 16 To 20
Sh.Fill.ForeColor.SchemeColor = 4 'Blue
End Select
Set Sh = ActiveSheet.Shapes("Pos11")
Select Case Range("A11")
Case 0
Sh.Fill.ForeColor.SchemeColor = 1 'White
Case 1 To 5
Sh.Fill.ForeColor.SchemeColor = 2 'Red
Case 6 To 10
Sh.Fill.ForeColor.SchemeColor = 51 'Orange
Case 11 To 15
Sh.Fill.ForeColor.SchemeColor = 27 'Light Blue
Case 16 To 20
Sh.Fill.ForeColor.SchemeColor = 4 'Blue
End Select
Set Sh = ActiveSheet.Shapes("Pos12")
Select Case Range("A12")
Case 0
Sh.Fill.ForeColor.SchemeColor = 1 'White
Case 1 To 5
Sh.Fill.ForeColor.SchemeColor = 2 'Red
Case 6 To 10
Sh.Fill.ForeColor.SchemeColor = 51 'Orange
Case 11 To 15
Sh.Fill.ForeColor.SchemeColor = 27 'Light Blue
Case 16 To 20
Sh.Fill.ForeColor.SchemeColor = 4 'Blue
End Select
Set Sh = ActiveSheet.Shapes("Pos13")
Select Case Range("A13")
Case 0
Sh.Fill.ForeColor.SchemeColor = 1 'White
Case 1 To 5
Sh.Fill.ForeColor.SchemeColor = 2 'Red
Case 6 To 10
Sh.Fill.ForeColor.SchemeColor = 51 'Orange
Case 11 To 15
Sh.Fill.ForeColor.SchemeColor = 27 'Light Blue
Case 16 To 20
Sh.Fill.ForeColor.SchemeColor = 4 'Blue
End Select
Set Sh = ActiveSheet.Shapes("Pos14")
Select Case Range("A14")
Case 0
Sh.Fill.ForeColor.SchemeColor = 1 'White
Case 1 To 5
Sh.Fill.ForeColor.SchemeColor = 2 'Red
Case 6 To 10
Sh.Fill.ForeColor.SchemeColor = 51 'Orange
Case 11 To 15
Sh.Fill.ForeColor.SchemeColor = 27 'Light Blue
Case 16 To 20
Sh.Fill.ForeColor.SchemeColor = 4 'Blue
End Select
Set Sh = ActiveSheet.Shapes("Pos15")
Select Case Range("A15")
Case 0
Sh.Fill.ForeColor.SchemeColor = 1 'White
Case 1 To 5
Sh.Fill.ForeColor.SchemeColor = 2 'Red
Case 6 To 10
Sh.Fill.ForeColor.SchemeColor = 51 'Orange
Case 11 To 15
Sh.Fill.ForeColor.SchemeColor = 27 'Light Blue
Case 16 To 20
Sh.Fill.ForeColor.SchemeColor = 4 'Blue
End Select
Set Sh = ActiveSheet.Shapes("Pos16")
Select Case Range("A16")
Case 0
Sh.Fill.ForeColor.SchemeColor = 1 'White
Case 1 To 5
Sh.Fill.ForeColor.SchemeColor = 2 'Red
Case 6 To 10
Sh.Fill.ForeColor.SchemeColor = 51 'Orange
Case 11 To 15
Sh.Fill.ForeColor.SchemeColor = 27 'Light Blue
Case 16 To 20
Sh.Fill.ForeColor.SchemeColor = 4 'Blue
End Select
Set Sh = ActiveSheet.Shapes("Pos17")
Select Case Range("A17")
Case 0
Sh.Fill.ForeColor.SchemeColor = 1 'White
Case 1 To 5
Sh.Fill.ForeColor.SchemeColor = 2 'Red
Case 6 To 10
Sh.Fill.ForeColor.SchemeColor = 51 'Orange
Case 11 To 15
Sh.Fill.ForeColor.SchemeColor = 27 'Light Blue
Case 16 To 20
Sh.Fill.ForeColor.SchemeColor = 4 'Blue
End Select
Set Sh = ActiveSheet.Shapes("Pos18")
Select Case Range("A18")
Case 0
Sh.Fill.ForeColor.SchemeColor = 1 'White
Case 1 To 5
Sh.Fill.ForeColor.SchemeColor = 2 'Red
Case 6 To 10
Sh.Fill.ForeColor.SchemeColor = 51 'Orange
Case 11 To 15
Sh.Fill.ForeColor.SchemeColor = 27 'Light Blue
Case 16 To 20
Sh.Fill.ForeColor.SchemeColor = 4 'Blue
End Select
Set Sh = ActiveSheet.Shapes("Pos19")
Select Case Range("A19")
Case 0
Sh.Fill.ForeColor.SchemeColor = 1 'White
Case 1 To 5
Sh.Fill.ForeColor.SchemeColor = 2 'Red
Case 6 To 10
Sh.Fill.ForeColor.SchemeColor = 51 'Orange
Case 11 To 15
Sh.Fill.ForeColor.SchemeColor = 27 'Light Blue
Case 16 To 20
Sh.Fill.ForeColor.SchemeColor = 4 'Blue
End Select
Set Sh = ActiveSheet.Shapes("Pos20")
Select Case Range("A20")
Case 0
Sh.Fill.ForeColor.SchemeColor = 1 'White
Case 1 To 5
Sh.Fill.ForeColor.SchemeColor = 2 'Red
Case 6 To 10
Sh.Fill.ForeColor.SchemeColor = 51 'Orange
Case 11 To 15
Sh.Fill.ForeColor.SchemeColor = 27 'Light Blue
Case 16 To 20
Sh.Fill.ForeColor.SchemeColor = 4 'Blue
End Select
End Sub
 

erik.van.geit

MrExcel MVP
Joined
Feb 1, 2003
Messages
17,832
I'll take a look at one condition:

The mind of an Excel-lover is full of structure. It loves reading code which is indented: analysing is quicker: so every effort can go to the problem itself...

To let the code stay indented do the following.
Click "reply"
write your message
select your code
click the "Code"-button
(or Click code button, paste your code, click "Code" button again.)
Submit

A real relief for those who try to help you !

WITHOUT
Sub Macro4()
For i = 1 To 3
For j = 1 To 3
m = m & i & j & Chr(10)
Next j
Next i
MsgBox m
End Sub

WITH
Code:
Sub Macro4()
    For i = 1 To 3
        For j = 1 To 3
        m = m & i & j & Chr(10)
        Next j
    Next i
MsgBox m
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,113,953
Messages
5,545,148
Members
410,666
Latest member
Al3cs
Top