VBA Shape handling error: Run-time error '-2147024809 (80070057)'

[malloc]

Hi,

I'm trying to get around a rather basic problem.

If you create an AutoShape, say an Oval. Then switch on the Macro recorder, click on the shape to select it, then switch off the macro recorder.

If you look at your newly created code you will have one line of very simple code, refering to the object name of the shape followed by the select command.

Now try running that code. When I do I get the thread title error:
Run-time error '-2147024809 (80070057)'
The item with the specified name wasn't found

I have no idea of why and have no idea of what to do to get around it. I've searched and searched and not come across anything useful. Any help much appreciated please.

Thanks!

 

[Domenic]

I following your steps, but did not get an error. I'm using Excel 2010.

 

[malloc]

Thanks for trying. It's work for me in Excel 2010, but not 2003.

At work I use Excel 2003 and it doesn't work. I'm working on a project which involves creating a bubble chart, where I need to add a series for each bubble so as to get the label name. I have about 200 bubbles, in about 8 categories and I want each category a particular colour, which is partially transparent. To do that I'm creating a circle, making it partially transparent, copying it and then pasting it on the bubble. This is when I met with this error. Even when I have the simplest function in the world with that one line it still doesn't like it. It's driving me bonkers...

 

[Domenic]

I'm not sure I can help, but can you post the exact code?

 

[malloc]

Thanks for taking an interest. I've pasted the whole thing below. As you can tell my knowledge of VBA is gained from pressing record, guesswork and google. It might be that writing it smarter would get around it, so I'm open to any suggestions.

Sub Macro4()

Dim i, numrows As Integer
i = 1
numrows = 1
Sheets("Sheet1").Select

' How many bubbles to create
Range("AC10").Select
Selection.End(xlDown).Select
numrows = ActiveCell.Row - 10

' Add the chart and make is a bubble chart
Charts.Add
ActiveChart.SetSourceData Source:=Sheets("Sheet1").Range("AD10:AF11"), PlotBy:=xlColumns
ActiveChart.ChartType = xlBubble
ActiveChart.Location Where:=xlLocationAsObject, Name:="Sheet1"

' Add a new series for each bubble
Do
ActiveChart.SeriesCollection.NewSeries
i = i + 1
Loop Until i > numrows

'Oval names are Oval 50 to Oval 60
Dim Ovalvar1, Ovalvar2 As String
Ovalvar1 = "Oval "

' Create each bubble and assign it to a series
i = 1
Do
ActiveChart.SeriesCollection(i).XValues = Range("AD" & (i + 10 - 1)).Value
ActiveChart.SeriesCollection(i).Values = Range("AE" & (i + 10 - 1)).Value
ActiveChart.SeriesCollection(i).Name = Range("AG" & (i + 10 - 1)).Value
ActiveChart.SeriesCollection(i).BubbleSizes = "=Sheet1!R" & i + 10 - 1 & "C32"
ActiveChart.SeriesCollection(i).ApplyDataLabels AutoText:=True, LegendKey _
:=False, ShowSeriesName:=True, ShowCategoryName:=False, ShowValue:=False _
, ShowPercentage:=False, ShowBubbleSize:=False
' Format bubble
Range("A1").Select
Ovalvar2 = Ovalvar1 & ((Range("AH" & (i + 10)).Value) + 49)
'Code stops on next line, even hard coded version line below
'ActiveSheet.Shapes(Ovalvar & ((Range("AH" & (i + 10)).Value) + 49)).Select
ActiveSheet.Shapes("Oval 50").Select
ActiveSheet.Shapes(Ovalvar2).Select
Selection.Copy
ActiveChart.SeriesCollection(i).Select
Selection.Paste

' Formatting of bubbles
ActiveChart.SeriesCollection(i).DataLabels.Select
Selection.AutoScaleFont = True
With Selection.Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 6
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.Background = xlAutomatic
ActiveChart.SeriesCollection(i).DataLabels.Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.ReadingOrder = xlContext
.Position = xlLabelPositionCenter
.Orientation = xlHorizontal
End With
End With

i = i + 1

Loop Until i > numrows

' Post bubble creation chart formatting
ActiveChart.Legend.Select
Selection.Delete


With ActiveChart.ChartGroups(1)
.ShowNegativeBubbles = False
.SizeRepresents = xlSizeIsArea
.BubbleScale = 35
End With


ActiveChart.Axes(xlValue).Select
With ActiveChart.Axes(xlValue)
.MinimumScale = 0
.MaximumScaleIsAuto = True
.MinorUnitIsAuto = True
.MajorUnitIsAuto = True
.Crosses = xlAutomatic
.ReversePlotOrder = False
.ScaleType = xlLinear
.DisplayUnit = xlNone
End With

End Sub


'Recorded code which does not work
Sub Macro6()
ActiveSheet.Shapes("Oval 50").Select
ActiveSheet.Shapes("Oval 51").Select
ActiveSheet.Shapes("Oval 52").Select
ActiveSheet.Shapes("Oval 53").Select
ActiveSheet.Shapes("Oval 54").Select
ActiveSheet.Shapes("Oval 55").Select
ActiveSheet.Shapes("Oval 56").Select
ActiveSheet.Shapes("Oval 57").Select
ActiveSheet.Shapes("Oval 58").Select
ActiveSheet.Shapes("Oval 59").Select
ActiveSheet.Shapes("Oval 60").Select
End Sub

 

[malloc]

I'm an idiot. The first shape is actually Oval 51, not oval 50... AAAH.

 

[Domenic]

That's great. I'm glad you've sorted it out.

Cheers!

 

[ajayakannan]

Hi ,

I am getting the same run time error 2147024809-80070057 , when I execute the below macro . Please help . Red highlighted line is where the program stops with above specified error.



Sub Button1_Click()
'Procedure to set the Arc Percentages and the Textbox values


'Setting values and color for the Arc and Textbox object in the Dashboard sheet
With Worksheets("Dashboard")
SetArcPercentage .Shapes("ArcOverall"), Sheet5.Range("D5").Value
.Shapes("TBOverall").TextFrame.Characters.Text = Round(Sheet5.Range("D5").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBOverall"), .Shapes("ArcOverall"), Sheet5.Range("D5").Value


SetArcPercentage .Shapes("ArcOMNI"), Sheet5.Range("D23").Value
.Shapes("TBOMNI").TextFrame.Characters.Text = Round(Sheet5.Range("D23").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBOMNI"), .Shapes("ArcOMNI"), Sheet5.Range("D23").Value


SetArcPercentage .Shapes("ArcWSC"), Sheet5.Range("D15").Value
.Shapes("TBWSC").TextFrame.Characters.Text = Round(Sheet5.Range("D15").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBWSC"), .Shapes("ArcWSC"), Sheet5.Range("D15").Value

SetArcPercentage .Shapes("ArcAMES"), Sheet5.Range("D7").Value
.Shapes("TBAMES").TextFrame.Characters.Text = Round(Sheet5.Range("D7").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBAMES"), .Shapes("ArcAMES"), Sheet5.Range("D7").Value

SetArcPercentage .Shapes("ArcAuto"), Sheet5.Range("D31").Value
.Shapes("TBAUTO").TextFrame.Characters.Text = Round(Sheet5.Range("D31").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBAUTO"), .Shapes("ArcAuto"), Sheet5.Range("D31").Value

SetArcPercentage .Shapes("ArcSQL"), Sheet5.Range("D39").Value
.Shapes("TBSQL").TextFrame.Characters.Text = Round(Sheet5.Range("D39").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBSQL"), .Shapes("ArcSQL"), Sheet5.Range("D39").Value

SetArcPercentage .Shapes("ArcDOT"), Sheet5.Range("D47").Value
.Shapes("TBDOT").TextFrame.Characters.Text = Round(Sheet5.Range("D47").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBDOT"), .Shapes("ArcDOT"), Sheet5.Range("D47").Value

End With


'Setting values and color for the Arc and Textbox object in the OMNI sheet
With Worksheets("QA")
SetArcPercentage .Shapes("ArcOMNIDoc"), Sheet5.Range("D8").Value
.Shapes("TBOMNIDoc").TextFrame.Characters.Text = Round(Sheet5.Range("D8").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBOMNIDoc"), .Shapes("ArcOMNIDoc"), Sheet5.Range("D8").Value

SetArcPercentage .Shapes("ArcOMNIAppAndEnv"), Sheet5.Range("D9").Value
.Shapes("TBOMNIAppAndEnv").TextFrame.Characters.Text = Round(Sheet5.Range("D9").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBOMNIAppAndEnv"), .Shapes("ArcOMNIAppAndEnv"), Sheet5.Range("D9").Value

SetArcPercentage .Shapes("ArcOMNIProcess"), Sheet5.Range("D10").Value
.Shapes("TBOMNIProcess").TextFrame.Characters.Text = Round(Sheet5.Range("D10").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBOMNIProcess"), .Shapes("ArcOMNIProcess"), Sheet5.Range("D10").Value

SetArcPercentage .Shapes("ArcOMNITech"), Sheet5.Range("D11").Value
.Shapes("TBOMNITech").TextFrame.Characters.Text = Round(Sheet5.Range("D11").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBOMNITech"), .Shapes("ArcOMNITech"), Sheet5.Range("D11").Value

SetArcPercentage .Shapes("ArcOMNIBusiness"), Sheet5.Range("D12").Value
.Shapes("TBOMNIBusiness").TextFrame.Characters.Text = Round(Sheet5.Range("D12").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBOMNIBusiness"), .Shapes("ArcOMNIBusiness"), Sheet5.Range("D12").Value

SetArcPercentage .Shapes("ArcOMNITeam"), Sheet5.Range("D13").Value
.Shapes("TBOMNITeam").TextFrame.Characters.Text = Round(Sheet5.Range("D13").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBOMNITeam"), .Shapes("ArcOMNITeam"), Sheet5.Range("D13").Value

End With


'Setting values and color for the Arc and Textbox object in the AMES sheet
With Worksheets("PeopleSoft")
SetArcPercentage .Shapes("ArcAMESDoc"), Sheet5.Range("D24").Value
.Shapes("TBAMESDoc").TextFrame.Characters.Text = Round(Sheet5.Range("D24").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBAMESDoc"), .Shapes("ArcAMESDoc"), Sheet5.Range("D24").Value

SetArcPercentage .Shapes("ArcAMESAppAndEnv"), Sheet5.Range("D25").Value
.Shapes("TBAMESAppAndEnv").TextFrame.Characters.Text = Round(Sheet5.Range("D25").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBAMESAppAndEnv"), .Shapes("ArcAMESAppAndEnv"), Sheet5.Range("D25").Value

SetArcPercentage .Shapes("ArcAMESProcess"), Sheet5.Range("D26").Value
.Shapes("TBAMESProcess").TextFrame.Characters.Text = Round(Sheet5.Range("D26").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBAMESProcess"), .Shapes("ArcAMESProcess"), Sheet5.Range("D26").Value

SetArcPercentage .Shapes("ArcAMESTech"), Sheet5.Range("D27").Value
.Shapes("TBAMESTech").TextFrame.Characters.Text = Round(Sheet5.Range("D27").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBAMESTech"), .Shapes("ArcAMESTech"), Sheet5.Range("D27").Value

SetArcPercentage .Shapes("ArcAMESBusiness"), Sheet5.Range("D28").Value
.Shapes("TBAMESBusiness").TextFrame.Characters.Text = Round(Sheet5.Range("D28").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBAMESBusiness"), .Shapes("ArcAMESBusiness"), Sheet5.Range("D28").Value

SetArcPercentage .Shapes("ArcAMESTeam"), Sheet5.Range("D29").Value
.Shapes("TBAMESTeam").TextFrame.Characters.Text = Round(Sheet5.Range("D29").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBAMESTeam"), .Shapes("ArcAMESTeam"), Sheet5.Range("D29").Value


End With


'Setting values and color for the Arc and Textbox object in the WSC sheet
With Worksheets("TIBCO")


SetArcPercentage .Shapes("ArcWSCDoc"), Sheet5.Range("D16").Value
.Shapes("TBWSCDOC").TextFrame.Characters.Text = Round(Sheet5.Range("D16").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBWSCDOC"), .Shapes("ArcWSCDoc"), Sheet5.Range("D16").Value

SetArcPercentage .Shapes("ArcWSCAppAndEnv"), Sheet5.Range("D17").Value
.Shapes("TBWSCAppAndEnv").TextFrame.Characters.Text = Round(Sheet5.Range("D17").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBWSCAppAndEnv"), .Shapes("ArcWSCAppAndEnv"), Sheet5.Range("D17").Value

SetArcPercentage .Shapes("ArcWSCProcess"), Sheet5.Range("D18").Value
.Shapes("TBWSCProcess").TextFrame.Characters.Text = Round(Sheet5.Range("D18").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBWSCProcess"), .Shapes("ArcWSCProcess"), Sheet5.Range("D18").Value

SetArcPercentage .Shapes("ArcWSCTech"), Sheet5.Range("D19").Value
.Shapes("TBWSCTech").TextFrame.Characters.Text = Round(Sheet5.Range("D19").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBWSCTech"), .Shapes("ArcWSCTech"), Sheet5.Range("D19").Value

SetArcPercentage .Shapes("ArcWSCBusiness"), Sheet5.Range("D20").Value
.Shapes("TBWSCBusiness").TextFrame.Characters.Text = Round(Sheet5.Range("D20").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBWSCBusiness"), .Shapes("ArcWSCBusiness"), Sheet5.Range("D20").Value

SetArcPercentage .Shapes("ArcWSCTeam"), Sheet5.Range("D21").Value
.Shapes("TBWSCTeam").TextFrame.Characters.Text = Round(Sheet5.Range("D21").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBWSCTeam"), .Shapes("ArcWSCTeam"), Sheet5.Range("D21").Value

End With


'Setting values and color for the Arc and Textbox object in the Automation sheet
With Worksheets("HYPERION")
SetArcPercentage .Shapes("ArcAUTODoc"), Sheet5.Range("D32").Value
.Shapes("TBAUTODOC").TextFrame.Characters.Text = Round(Sheet5.Range("D32").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBAUTODOC"), .Shapes("ArcAUTODoc"), Sheet5.Range("D32").Value

SetArcPercentage .Shapes("ArcAUTOAppAndEnv"), Sheet5.Range("D33").Value
.Shapes("TBAUTOAppAndEnv").TextFrame.Characters.Text = Round(Sheet5.Range("D33").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBAUTOAppAndEnv"), .Shapes("ArcAUTOAppAndEnv"), Sheet5.Range("D33").Value

SetArcPercentage .Shapes("ArcAUTOProcess"), Sheet5.Range("D34").Value
.Shapes("TBAUTOProcess").TextFrame.Characters.Text = Round(Sheet5.Range("D34").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBAUTOProcess"), .Shapes("ArcAUTOProcess"), Sheet5.Range("D34").Value

SetArcPercentage .Shapes("ArcAUTOTech"), Sheet5.Range("D35").Value
.Shapes("TBAUTOTech").TextFrame.Characters.Text = Round(Sheet5.Range("D35").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBAUTOTech"), .Shapes("ArcAUTOTech"), Sheet5.Range("D35").Value

SetArcPercentage .Shapes("ArcAUTOBusiness"), Sheet5.Range("D36").Value
.Shapes("TBAUTOBusiness").TextFrame.Characters.Text = Round(Sheet5.Range("D36").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBAUTOBusiness"), .Shapes("ArcAUTOBusiness"), Sheet5.Range("D36").Value

SetArcPercentage .Shapes("ArcAUTOTeam"), Sheet5.Range("D37").Value
.Shapes("TBAUTOTeam").TextFrame.Characters.Text = Round(Sheet5.Range("D37").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBAUTOTeam"), .Shapes("ArcAUTOTeam"), Sheet5.Range("D37").Value


End With


'Begin : Added by Jaikumar SK----


With Worksheets("SQLDBA")
SetArcPercentage .Shapes("ArcSQLDoc"), Sheet5.Range("D40").Value
.Shapes("TBSQLDOC").TextFrame.Characters.Text = Round(Sheet5.Range("D40").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBSQLDOC"), .Shapes("ArcSQLDoc"), Sheet5.Range("D40").Value

SetArcPercentage .Shapes("ArcSQLAppAndEnv"), Sheet5.Range("D41").Value
.Shapes("TBSQLAppAndEnv").TextFrame.Characters.Text = Round(Sheet5.Range("D41").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBSQLAppAndEnv"), .Shapes("ArcSQLAppAndEnv"), Sheet5.Range("D41").Value

SetArcPercentage .Shapes("ArcSQLProcess"), Sheet5.Range("D42").Value
.Shapes("TBSQLProcess").TextFrame.Characters.Text = Round(Sheet5.Range("D42").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBSQLProcess"), .Shapes("ArcSQLProcess"), Sheet5.Range("D42").Value

SetArcPercentage .Shapes("ArcSQLTech"), Sheet5.Range("D43").Value
.Shapes("TBSQLTech").TextFrame.Characters.Text = Round(Sheet5.Range("D43").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBSQLTech"), .Shapes("ArcSQLTech"), Sheet5.Range("D43").Value

SetArcPercentage .Shapes("ArcSQLBusiness"), Sheet5.Range("D44").Value
.Shapes("TBSQLBusiness").TextFrame.Characters.Text = Round(Sheet5.Range("D44").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBSQLBusiness"), .Shapes("ArcSQLBusiness"), Sheet5.Range("D44").Value

SetArcPercentage .Shapes("ArcSQLTeam"), Sheet5.Range("D45").Value
.Shapes("TBSQLTeam").TextFrame.Characters.Text = Round(Sheet5.Range("D45").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBSQLTeam"), .Shapes("ArcSQLTeam"), Sheet5.Range("D45").Value


End With


With Worksheets(".NET")
SetArcPercentage .Shapes("ArcDOTDoc"), Sheet5.Range("D48").Value
.Shapes("TBDOTDOC").TextFrame.Characters.Text = Round(Sheet5.Range("D48").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBDOTDOC"), .Shapes("ArcDOTDoc"), Sheet5.Range("D48").Value

SetArcPercentage .Shapes("ArcDOTAppAndEnv"), Sheet5.Range("D49").Value
.Shapes("TBDOTAppAndEnv").TextFrame.Characters.Text = Round(Sheet5.Range("D49").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBDOTAppAndEnv"), .Shapes("ArcDOTAppAndEnv"), Sheet5.Range("D49").Value

SetArcPercentage .Shapes("ArcDOTProcess"), Sheet5.Range("D50").Value
.Shapes("TBDOTProcess").TextFrame.Characters.Text = Round(Sheet5.Range("D50").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBDOTProcess"), .Shapes("ArcDOTProcess"), Sheet5.Range("D50").Value

SetArcPercentage .Shapes("ArcDOTTech"), Sheet5.Range("D51").Value
.Shapes("TBDOTTech").TextFrame.Characters.Text = Round(Sheet5.Range("D51").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBDOTTech"), .Shapes("ArcDOTTech"), Sheet5.Range("D51").Value

SetArcPercentage .Shapes("ArcDOTBusiness"), Sheet5.Range("D52").Value
.Shapes("TBDOTBusiness").TextFrame.Characters.Text = Round(Sheet5.Range("D52").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBDOTBusiness"), .Shapes("ArcDOTBusiness"), Sheet5.Range("D52").Value

SetArcPercentage .Shapes("ArcDOTTeam"), Sheet5.Range("D53").Value
.Shapes("TBDOTTeam").TextFrame.Characters.Text = Round(Sheet5.Range("D53").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBDOTTeam"), .Shapes("ArcDOTTeam"), Sheet5.Range("D53").Value


End With








End Sub
Private Sub SetArcPercentage(objArc As Shape, Percentage As Integer)
' Procedure to set the angle of the passed arc as per the percentage passed


' Formula ==== 180 degrees = 100 % then x percentage = ? angle
' Formula ==== angle = 180 x percentage passed / 100
' But excel angle in negative so formula will become
' Formula ==== angle = (-180 x (100-percentages passed)) / 100


Dim intArcAngle As Integer


'Handle the 0% - 0 value will set the arc angle to 360 which we do not want!
If Percentage <> 0 Then
intArcAngle = (-180 * (100 - Percentage)) / 100
Else
intArcAngle = -175
End If
objArc.Adjustments.Item(2) = intArcAngle
End Sub


Private Function GetCurrentWeekTargetPercentage() As Integer
'A function to retrive the current week value ans based on that
'retrive the target percentage for setting the color of the percentage values


'Code uses named ranges (cells) in the Input work sheet


Select Case Range("I5").Value
Case 1 'Week 1
GetCurrentWeekTargetPercentage = Range("H18").Value
Case 2 'Week 2
GetCurrentWeekTargetPercentage = Range("H19").Value
Case 3 'Week 3
GetCurrentWeekTargetPercentage = Range("H20").Value
Case 4 'Week 4
GetCurrentWeekTargetPercentage = Range("H21").Value
Case 5 'Week 5
GetCurrentWeekTargetPercentage = Range("H22").Value
Case 6 'Week 6
GetCurrentWeekTargetPercentage = Range("H23").Value
Case Else 'Error - Return 0
GetCurrentWeekTargetPercentage = 0
End Select


End Function
Private Function GetCurrentWeekYellowPercentage() As Integer
'A function to retrive the current week Yellow value


'Code uses named ranges (cells) in the Input work sheet


Select Case Range("I5").Value
Case 1 'Week 1
GetCurrentWeekYellowPercentage = Range("I18").Value
Case 2 'Week 2
GetCurrentWeekYellowPercentage = Range("I19").Value
Case 3 'Week 3
GetCurrentWeekYellowPercentage = Range("I20").Value
Case 4 'Week 4
GetCurrentWeekYellowPercentage = Range("I21").Value
Case 5 'Week 5
GetCurrentWeekYellowPercentage = Range("I22").Value
Case 6 'Week 6
GetCurrentWeekYellowPercentage = Range("I23").Value
Case Else 'Error - Return 0
GetCurrentWeekYellowPercentage = 0
End Select


End Function
Private Sub SetTextAndArcColor(objTextBox As Shape, objArc As Shape, Percentage As Integer)
'Procedure to set the text color of the percentage text boxes according to the value


'Calls the GetCurrentWeekTargetPercentage for comparing the incoming percentage


'Get the percentage deviation value from the named cell
Dim intTargetPercentage As Integer


intTargetPercentage = GetCurrentWeekTargetPercentage


'First check whether the percenatge is more than the target
'Then set the color to green and exit the sube
If Percentage > intTargetPercentage Then
objTextBox.TextFrame.Characters.Font.Color = vbGreen
objArc.Line.ForeColor.RGB = vbGreen
Exit Sub
End If

'If the percentage is less than the target percetnage
'Then calculate the deviation first
Dim intYellowPercentage As Integer
intYellowPercentage = GetCurrentWeekYellowPercentage


'If the deviation is not within the limits then the color is red
If Percentage < intYellowPercentage Then
objTextBox.TextFrame.Characters.Font.Color = vbRed
objArc.Line.ForeColor.RGB = vbRed
Else 'Else it is within the limits then the color is yellow
objTextBox.TextFrame.Characters.Font.Color = vbYellow
objArc.Line.ForeColor.RGB = vbYellow
End If


End Sub

Regards,
JK