Change color of an autoshape

[Guest]

I am using Excel 2003 for my project and I have to set color of an autoshape
in column C based on the value in column B. For example:
*If the value in column B < 80%, a little square in column C must be Red
*If the value in column B is from 80% to 89%, a little square in column C
must be Yellow.
*If the value in column B > 90%, a little square in C must be Green.

I've tried Conditional format, but it didn't work. Can someone help me
please.
Any help is appreciate.

 

[Guest]

Let me explain th eprocess to get this done. There are some tricks to get it
right.

First you need to record a macro to set the shape name. This is the easiest
way of getting the same name.

1) On worksheet go to Tools Menu - Macro - Record macro
2) select Shape and manually change the color.
3) Below is the macro I go doing these steps

' Macro recorded 9/20/2007 by Joel
'
'
ActiveSheet.Shapes("AutoShape 1").Select
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 10
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.Solid
End Sub

4) "AutoShape 1" is the name. 10 is the color for Red, 13 is yellow, 17 is
green


5) To get the color to change automatically need you need a worksheet change
function as I shown below. You need tto modify the code below by putting in
the shape name from the macro that was learned above. Also you need to
change the cell address in the following line of code "$B$7" is cell B7. One
trick that most people don't know is the learned macro had ShapeRange that I
had to remove to get my worksheet_change function to run without errors.

If target.Address = "$B$7" Then


Sub worksheet_change(ByVal target As Range)

If target.Address = "$B$7" Then
If target < 0.8 Then

ActiveSheet.Shapes("AutoShape 1"). _
Fill.ForeColor.SchemeColor = 10
End If
If (target >= 0.8) And (target <= 0.9) Then

ActiveSheet.Shapes("AutoShape 1"). _
Fill.ForeColor.SchemeColor = 13
End If
If target > 0.9 Then

ActiveSheet.Shapes("AutoShape 1"). _
Fill.ForeColor.SchemeColor = 17
End If

End If

End Sub

 

[Guest]

Thank you very much for a fast help.
I've tried to call your function worksheet_change() by passing a range $B$7
as following:

Sub AutoColor()
Call worksheet_change($B$7)
End Sub

I got an error: Syntax Error. What I am doing wrong here? I understand that
I have to pass by "value" a range in the worksheet where I store a number.
Is it right?

 

[Guest]

Please ignore my previous reply. I got it now. I forgot to specify what sheet
the range is belong to. I try the following sub and it works:

Sub AutoColor()
Call worksheet_change(Sheets("Sheet1").Range("$B$7"))
End Sub

Thanks a lot for your help. I'll work on the looping to make it works for
many rows of in the sheet.

 

[Guest]

Ly: Worksheet change functions automaticaly get called by excel and
automatically pass the range of cells.

You place the worksheet change function on Sheets in Excel not modules. If
you go to view on the VBA window and enable the program Manager yu will see
the modules and sheets that are available for writing VBA code. You can also
add more modules to the project.

If you need to have the code work on more than worksheet you have to copy
the worksheet change code to each worksheet.

To get the code to work with a Range of cells uses the modification below.
This is need if somebody does a cut and paste of multiple cells. The old
code would only work for the first cell of the selected range. The new code
will look at all the cells in the range.


Sub worksheet_change(ByVal target As Range)
for each cell in Target
If cell.Address = "$B$7" Then
If cell.value < 0.8 Then

ActiveSheet.Shapes("AutoShape 1"). _
Fill.ForeColor.SchemeColor = 10
End If
If (cell.value >= 0.8) And (cell.value <= 0.9) Then

ActiveSheet.Shapes("AutoShape 1"). _
Fill.ForeColor.SchemeColor = 13
End If
If cell.value > 0.9 Then

ActiveSheet.Shapes("AutoShape 1"). _
Fill.ForeColor.SchemeColor = 17
End If

End If
next cell
End Sub

 

[Guest]

Hello Joel,

I was busy with another project and I didn't have time to work on this
problem until now.

1. I tried your script on the "Module", delete the following line and change
the name of autoshape. It works . Many thanks.
"If cell.Address = "$B$7" Then"

2. I have a question on your following comment:

Ly: Worksheet change functions automaticaly get called by excel and
automatically pass the range of cells.

On VBA editor, I paste your code on the Sheet1 under VBAProject, but I'm not
sure how to run this. When I selected Run ->Run Sub/UserForm, a Macro dialog
pop up, but it doesn't have a name of the sub "worksheet_change" under a list
of Macro. How do I run this sub?

Thanks,
Ly