AutoShape Macro Help

[jack]

Excel 2003

I have 50 sales regions on a map with 50 autoshapes for each region on sheet
2.

On sheet 1, there's a column listing of the regions and a corresponding
column C7:C57 that's to be filled in when each region reaches its goal. On
sheet 2, there's a table listing the regions and the corresponding auto
shape numbers in C71:C121

What I want to do is change the specific autoshape from red to green on the
region map as each region reaches its goal.

What I think I need is some code based on a change on sheet 1 to modify the
color of specific autoshape on sheet 2. However, I can't seem to get it to
work .

Here's what I have been working with but not succeeding.

Any guidance would be appreciated. as I don't think I have the proper coding
to use the autoshapes.



Private Sub Worksheet_Change(ByVal Target As Range)



'Change Smiley face Red / Green depending if "X" is in goal cell for region



'Dim i, j As Long



' Application.ScreenUpdating = False



'Worksheets("Sheet2").Unprotect

For i = 7 To 57

For j = 71 To 121

If Worksheets("Sheet1").Range("C" & i) = "" Then

ActiveSheet.Shapes("AutoShape 3").Select 'NEED TO CHANGE TO SELECT
EACH SHAPE

Call toRed

Else

'ActiveSheet.Shapes("Worksheets.("sheet2").range("C" &
j("AutoShape 3").Select

'Worksheets("sheet2").range("C & j).shapes("Autoshape 3").select

Call toGreen

End If

Next j

Next i

' Worksheets("sheet1").Protect DrawingObjects:=False, Contents:=True,
Scenarios:= _

' True, AllowFormattingCells:=True, AllowSorting:=True

' Application.ScreenUpdating = True



End Sub

 

[Joel]

See if this code will help. Make sure the shape names match the names shown
in the message box.

Sub test()

For Each sh In ActiveSheet.Shapes
MsgBox ("shape Name = " & sh.Name)
sh.Fill.ForeColor.SchemeColor = 10
Next sh

End Sub

 

[Ken Johnson]

Public Sub Goal()
Dim I As Integer
For I = 7 To 57
If Worksheets("Sheet1").Range("C" & I) = "" Then
ActiveSheet.Shapes("AutoShape " & _
Range("C" & 71 + I - 7).Value).Fill.ForeColor.SchemeColor = 10
Else: ActiveSheet.Shapes("AutoShape " & _
Range("C" & 71 + I - 7).Value).Fill.ForeColor.SchemeColor = 3
End If
Next I
End Sub

Ken Johnson

 

[jack]

Ken,
Thanks for your input. I was unsure how to correctly state:
ActiveSheet.Shapes("AutoShape " & _
Range("C" & 71 + I - 7).Value).Fill.ForeColor.SchemeColor = 10
to get the change to the Autoshape.
However, when I run the your suggested code I receive the error message
"Subscript out of range (Error 9)" on the statement:
If Worksheets("Sheet1").Range("C" & I) = "" Then
Have I done something wrong? If so, how do I correct it?
Thanks
Jack

 

[Ken Johnson]

Hi Jack,

I'm guessing that the out of range subscript is the "Sheet1" in
Worksheets("Sheet1") part.

What is the name (tab) of the sheet with the cells that are being
tested for "" (goal)?

Ken Johnson

 

[jack]

Ken,
Thanks!!!
I didn't realize that if the tab had name other than "sheet1" it needed to
be used. I changed the code using tab name that I named it and all seems to
work fine!
I thought it would be something simple and that was the case!
Sign me: Still Learning!
I'm trying an additional step of changing the sad face to a smiley face when
changing from red to green. I'll post back if I need additional help with
that.
Thanks very much again...
Jack

 

[Ken Johnson]

Hi Jack,

the Smiley Face's yellow adjustment in VBA is referred to as
Adjustments.Item(1) which on the happiest face equals 0.8111111 and on
the saddest face equals 0.7180555

This code makes smiley face Autoshape 1 happy when A1 of the same
sheet is not blank and very sad when it is.

ActiveSheet.Shapes("Autoshape 1").Adjustments.Item(1) =
IIf(Range("A1") <> "", 0.8111111, 0.7180555)

You can also use a loop to show the transition between the two moods
ie watch the face changing its smile, that that's probably going a bit
overboard.

Ken Johnson

 

[jack]

Hi Ken,
I'm getting the error message: "Invalid procedure call or argument (Error
5)" when I place the following code in the Sheet1(Upsell Record). The error
message appears at statement:
ActiveSheet.Shapes("AutoShape " & _
Range("C" & 71 + I - 7).Value).Fill.ForeColor.SchemeColor = 11 'Green
when I step (F8) through the code.
The code runs OK when in Module 1.
As you can see by the commented lines, my plan is to run the code when a
change occurs on Sheet1(Upsell Record). "'Private Sub
Worksheet_Change(ByVal Target As Range)"

I'm stumped.... any suggestions on what's happening and how I can correct
it?
Jack

Sub test()
'
'Private Sub Worksheet_Change(ByVal Target As Range)
'
''Change Smiley face Red / Green depending if "X" is in Upsell cell for
Region
'
'
'' Application.ScreenUpdating = False
'
'' Worksheets("Map").Unprotect
'
''Change from red to green
Dim I As Integer
For I = 7 To 57
If Worksheets("Upsell Record").Range("C" & I) = "" Then
Worksheets("Map").Activate 'is needed?
ActiveSheet.Shapes("AutoShape " & _
Range("C" & 71 + I - 7).Value).Fill.ForeColor.SchemeColor = 11 'Green
ActiveSheet.Shapes("AutoShape " & _
Range("C" & 71 + I - 7).Value).Adjustments.Item(1) = 0.8111
Else: ActiveSheet.Shapes("AutoShape " & _
Range("C" & 71 + I - 7).Value).Fill.ForeColor.SchemeColor = 10 'Red
ActiveSheet.Shapes("AutoShape " & _
Range("C" & 71 + I - 7).Value).Adjustments.Item(1) = 0.7181
End If
Next I
' Worksheets("Upsell Record").Activate
'
'' Worksheets("Map").Protect DrawingObjects:=False, Contents:=True,
Scenarios:= _
'' True, AllowFormattingCells:=True, AllowSorting:=True
'' Application.ScreenUpdating = True
'
End Sub

 

[Ken Johnson]

Hi Jack,

If the values in C7:C57 on the "Upsell Record" sheet are the result of
a formula then the event you should use is the WorksheetCalculate
event. Is the "X" the result of a formula?

Are you going to have all the code in the worksheet's code module or
have the code in a standard module and use the WorksheetCalculate
event to call the code?

If this is the only automatically run code you intend using in the
workbook then having all the code in the Worksheet's
WorksheetCalculate event procedure will be OK.

Ken Johnson

 

[jack]

Hi Ken,
The value(s) in C7:C57 on the "Upsell Record" sheet are the result of the
user adding an "X" to the cell. Based on that change, my intent is to
change the smiley face (sad / red to happy / green) on the "Map" sheet. I
thought that having the code in the worksheet's code module with
Worksheet_Change was the way to go for changing the "Map" sheet smiley
face(s) based on the "Upsell Record" sheet change triggering the change to
the "Map" sheet smiley face(s).
Won't the code work as a Worksheet_Change and is that why the error message
occurs?
Any suggestions on the way to go to correct the error?

I do have one other code as a Worksheet_BeforeDoubleClick in the "Upsell
Record" sheet worksheet's code module and that is working satisfactorily.
I appreciate your help
Jack

 

[Ken Johnson]

Hi Jack,

OK, so the Worksheet Change Event will work.
I had it working for the WorksheetCalculate, so I'll just do the same
with the WorksheetChange.

Won't be long.

Ken Johnson

 

[Ken Johnson]

Hi Jack,

copy this code and paste it into the Upsell Record code module.

The first line checks if any cells in C7:C57 have been changed.
Normally you would expect only one of the C7:C57 to change, but
because of the possibility of the user actually pasting a whole array
of Xs and blanks into C7:C57 then the code has to loop through all of
those cells that have changed.
One part you might find curious is the 64 in...

With Worksheets("Map").Shapes("AutoShape " & _
Worksheets("Map").Range("C" & rgCell.Row + 64).Value)

Say the top most cell (C7) was changed, then rgCell is C7 and
rgCell.Row is 7. Add 64 to that 7 and you get 71, the row of the
topmost cell in C71:C121 on the Map worksheet, and this cell (C7)
holds the number of the AutoShape that needs to be changed.


Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("C7:C57")) Is Nothing Then
Dim rgCell As Range
For Each rgCell In Target
If rgCell.Value = "" Then
With Worksheets("Map").Shapes("AutoShape " & _
Worksheets("Map").Range("C" & rgCell.Row + 64).Value)
..Fill.ForeColor.SchemeColor = 11 'Green
..Adjustments.Item(1) = 0.8111
End With
Else: With Worksheets("Map").Shapes("AutoShape " & _
Worksheets("Map").Range("C" & rgCell.Row + 64).Value)
..Fill.ForeColor.SchemeColor = 10 'Red
..Adjustments.Item(1) = 0.7181
End With
End If
Next rgCell
End If
End Sub

Let me know how you go.

Ken Johnson

 

[Ken Johnson]

Oops!

", and this cell (C7) holds the number of the AutoShape that needs to
be changed."

was meant to be...

", and this cell (C71) holds the number of the AutoShape that needs to
be changed."

Ken Johnson

 

[jack]

Hi Ken,
Thanks very much for your help. The code is doing exactly as I entended.
My plan was to start off with red faces and change to green if the cell was
filled in. So I changed the the code just slightly.
I appreciate your explanation of the "64" in the code and have added it in
comments to the code so I will remember what "happens" when I refer to it
later.
I've still got to do some protection so that the users don't "mess" with map
and the autoshapes.

I've learned several things, with thanks to you, that probably would still
be a struggle for me several weeks from now. Its great that there are
people out there in the news groups like you that can offer assistance to
folks like me that want to learn.
Thanks again...
Jack

 

[Ken Johnson]

Hi Ken,
Thanks very much for your help. The code is doing exactly as I entended.
My plan was to start off with red faces and change to green if the cell was
filled in. So I changed the the code just slightly.
I appreciate your explanation of the "64" in the code and have added it in
comments to the code so I will remember what "happens" when I refer to it
later.
I've still got to do some protection so that the users don't "mess" with map
and the autoshapes.

I've learned several things, with thanks to you, that probably would still
be a struggle for me several weeks from now. Its great that there are
people out there in the news groups like you that can offer assistance to
folks like me that want to learn.
Thanks again...
Jack

You're welcome Jack.

Ken Johnson

 

[noyau]

Hi Ken,

Although seems easier, I was unable to suit you code to my own situation.

I have a value in a cell say A1. It is either zero or a fix number. I want
to change the color of a shape regarding the vale of cell A1.
If A1=0 then Autoshape is red, else AutoShape is green?

Where to start?

all my best.

nyn

 

[Don Guillett]

I didn't see your original post but this could be placed in the
worksheet_change event to be automatic

Sub autocolor()
With ActiveSheet.Shapes("Rectangle 1").Fill.ForeColor
If Range("d1") > 0 Then
.SchemeColor = 11
Else
..SchemeColor = 53
End If
End With
End Sub