Index into specificied collection is out of bounds error

[iamaichgee]

Hi VBA Express,

I'm sort of a newbie in VBA and I'm trying to build a macro that draws a diagram which shades in portions of segments depending on certain values in the excel spreadsheet. Here's what I currently have:


Sub CreateChart()

' Remove the current diagram on Sheet 1
RemoveOtherShapes
' Take a copy of the original diagram and place in main worksheet
CopyNewShape
' Now apply the scale for each piece
Dim nScale As Double

'Segment1
nScale = Worksheets(1).Cells(2, 2)
ActiveSheet.Shapes("Segment1").ScaleHeight nScale, msoFalse, msoScaleFromBottomRight
ActiveSheet.Shapes("Segment1").ScaleWidth nScale, msoFalse, msoScaleFromBottomRight
Call MoveSideSegmentsBack(nScale, 2)

'Segment2
nScale = Worksheets(1).Cells(3, 2)
ActiveSheet.Shapes(6).ScaleHeight nScale, msoFalse, msoScaleFromTopLeft
ActiveSheet.Shapes(6).ScaleWidth nScale, msoFalse, msoScaleFromTopLeft
Call MoveSideSegmentsBack(nScale, 6)

'Segment3
nScale = Worksheets(1).Cells(4, 2)
ActiveSheet.Shapes(5).ScaleHeight nScale, msoFalse, msoScaleFromBottomRight
ActiveSheet.Shapes(5).ScaleWidth nScale, msoFalse, msoScaleFromTopLeft
Call MoveSideSegmentsBack(nScale, 5)
'Segment4
nScale = Worksheets(1).Cells(5, 2)
ActiveSheet.Shapes(3).ScaleHeight nScale, msoFalse, msoScaleFromTopLeft
ActiveSheet.Shapes(3).ScaleWidth nScale, msoFalse, msoScaleFromBottomRight
Call MoveSideSegmentsBack(nScale, 3)

'Segment5
nScale = Worksheets(1).Cells(6, 2)
ActiveSheet.Shapes(4).ScaleWidth nScale, msoFalse, msoScaleFromTopLeft
ActiveSheet.Shapes(4).ScaleHeight nScale, msoFalse, msoScaleFromTopLeft
Call MoveSideSegmentsBack(nScale, 4)

GroupPieces
End Sub

Sub GroupPieces()

ActiveSheet.Shapes.Range(Array("Segment1", "Segment2", "Segment3", _
"Segment4", "Segment5", _
"Main")).Select
Selection.ShapeRange.Group.Select
Selection.Name = "WLMCS tool"
End Sub

Sub RemoveOtherShapes()
Dim oShape As Shape

Worksheets(1).Activate
For Each oShape In ActiveSheet.Shapes
If oShape.Name = "cmd_DrawChart" Then
'Do Nothing
ElseIf oShape.Name = "cmd_PrintChart" Then
'Do Nothing
Else
oShape.Delete
End If
Next oShape
End Sub

Sub CopyNewShape()

Worksheets(2).Activate
ActiveSheet.Shapes.SelectAll
' Range(Array("Main", "Segment1", "Segment2", "Segment3", _
' "Segment4", "Segment5")).Select
Selection.Copy
Worksheets(1).Activate
Range("F5").Select
ActiveSheet.Paste

End Sub
Sub MoveSideSegmentsBack(nScale As Double, Shape As Integer)

ActiveSheet.Shapes(Shape).Select
If nScale = 0.8 Then
If Shape = 2 Then
'do nothing
ElseIf Shape = 3 Then
Selection.ShapeRange.IncrementTop -42
Selection.ShapeRange.IncrementLeft 28
ElseIf Shape = 4 Then
Selection.ShapeRange.IncrementTop -32
Selection.ShapeRange.IncrementLeft 66
ElseIf Shape = 5 Then
Selection.ShapeRange.IncrementTop 30
Selection.ShapeRange.IncrementLeft -40
ElseIf Shape = 6 Then
Selection.ShapeRange.IncrementTop 64
Selection.ShapeRange.IncrementLeft -36
End If

ElseIf nScale = 0.6 Then
If Shape = 2 Then
'do nothing
ElseIf Shape = 3 Then
Selection.ShapeRange.IncrementTop -85
Selection.ShapeRange.IncrementLeft 59
ElseIf Shape = 4 Then
Selection.ShapeRange.IncrementTop -63
Selection.ShapeRange.IncrementLeft 131
ElseIf Shape = 5 Then
Selection.ShapeRange.IncrementTop 60
Selection.ShapeRange.IncrementLeft -80
ElseIf Shape = 6 Then
Selection.ShapeRange.IncrementTop 127
Selection.ShapeRange.IncrementLeft -71
End If


ElseIf nScale = 0.4 Then
If Shape = 2 Then
'do nothing
ElseIf Shape = 3 Then
Selection.ShapeRange.IncrementTop -128
Selection.ShapeRange.IncrementLeft 91
ElseIf Shape = 4 Then
Selection.ShapeRange.IncrementTop -94
Selection.ShapeRange.IncrementLeft 197
ElseIf Shape = 5 Then
Selection.ShapeRange.IncrementTop 89
Selection.ShapeRange.IncrementLeft -121
ElseIf Shape = 6 Then
Selection.ShapeRange.IncrementTop 182
Selection.ShapeRange.IncrementLeft -105
End If


ElseIf nScale = 0.2 Then
If Shape = 2 Then
'do nothing
ElseIf Shape = 3 Then
Selection.ShapeRange.IncrementTop -171
Selection.ShapeRange.IncrementLeft 122
ElseIf Shape = 4 Then
Selection.ShapeRange.IncrementTop -125
Selection.ShapeRange.IncrementLeft 263
ElseIf Shape = 5 Then
Selection.ShapeRange.IncrementTop 119
Selection.ShapeRange.IncrementLeft -161
ElseIf Shape = 6 Then
Selection.ShapeRange.IncrementTop 237
Selection.ShapeRange.IncrementLeft -139
End If
End If
End Sub




' 'Rename objects
'
'' ActiveSheet.Shapes(3).Select
'' Selection.Name = "What Levers Make Change Stick"
'' ActiveSheet.Shapes(4).Select
'' Selection.Name = "Segment 1"
'' ActiveSheet.Shapes(5).Select
'' Selection.Name = "Segment 2"
'' ActiveSheet.Shapes(6).Select
'' Selection.Name = "Segment 3"
'' ActiveSheet.Shapes(7).Select
'' Selection.Name = "Segment 4"
'' ActiveSheet.Shapes(8).Select
'' Selection.Name = "Segment 5"
'' ActiveSheet.Shapes(9).Select
'' Selection.Name = "Segment 6"
'

It's giving me an index error and I'm not too sure why.
I got the shapes' index by trial and erroring.
I've tried playing around using different naming conventions - e.g. between Shapes(2) & Shapes("Segment1").
Both give me errors but different errors.

Thanks in advance.

[mancubus]

welcome to the forum.

please take time to read the forum rules: http://www.vbaexpress.com/forum/faq.php

use code tags (see my signature)
post your workbook (see my signature)

these will help helpers on forums to understand your requirement and post a possible solution. when posting a file here replace your sensitive data with fake data.

enjoy VBAX



ps:
you can edit your messages in 5 hours after posting them.
so you still have time to insert the code tags and upload a sample file.