I am facing the Run time error 9: Subscript out of range for the below code, But it worked fine initially. But later when i collaborate all the modules to create add-in, Its showing error.
Sub SelectSimilarshapes()
Dim sh As Shape
Dim shapeCollection() As String
Set sh = ActiveWindow.Selection.ShapeRange(1)
ReDim Preserve shapeCollection(0)
shapeCollection(0) = sh.Name
Dim otherShape As Shape
Dim iShape As Integer
iShape = 1
For Each otherShape In ActiveWindow.View.Slide.Shapes
If otherShape.Type = sh.Type _
And otherShape.AutoShapeType = sh.AutoShapeType _
And otherShape.Type <> msoPlaceholder Then
If (otherShape.Name <> sh.Name) Then
ReDim Preserve shapeCollection(1 + iShape)
shapeCollection(iShape) = otherShape.Name
iShape = iShape + 1
End If
End If
Next otherShape
ActiveWindow.View.Slide.Shapes.Range(shapeCollection).Select
Select Case iShape
Case 1
MsgBox "Sorry, no shapes matching your search criteria were found"
Case Else
MsgBox "Shapes matching your search criteria were found and are selected"
End Select
NormalExit:
Exit Sub
err1:
MsgBox "You haven't selected any object"
Resume NormalExit:
End Sub
When declaring or resizing arrays you should specify both lower and upper index for this array, for example
ReDim Preserve shapeCollection(0 To 0)
instead of
ReDim Preserve shapeCollection(0)
In other languages arrays are usually indexed from 0 and there is no exception.
In VBA arrays can be indexed from any value, i.e.
Dim array(5 To 10) As String
If you skip the lower index it will have default value. The built-in default value is 0, but it can be changed to 1 with the following statement:
Option Base 1
placed at the top of a module. If there is such statement in the module, all arrays that have not declared their lower index, are indexed from 1.
The good practice is to always specify both indexes of array, since you never know if your Sub/Function would be moved to another module. And even if your arrays were indexed from 0, this new module can have Option Base 1
, and suddenty your arrays are indexed from 1 instead of 0.
I suppose this happens in your code.
Here is how you should change it:
Sub SelectSimilarshapes()
Dim sh As Shape
Dim shapeCollection() As String
Dim otherShape As Shape
Dim iShape As Integer
Set sh = ActiveWindow.Selection.ShapeRange(1)
ReDim Preserve shapeCollection(0 To 0)
shapeCollection(0) = sh.Name
iShape = 1
For Each otherShape In ActiveWindow.View.Slide.Shapes
If otherShape.Type = sh.Type _
And otherShape.AutoShapeType = sh.AutoShapeType _
And otherShape.Type <> msoPlaceholder Then
If (otherShape.Name <> sh.Name) Then
ReDim Preserve shapeCollection(0 To 1 + iShape)
shapeCollection(iShape) = otherShape.Name
iShape = iShape + 1
End If
End If
Next otherShape
ActiveWindow.View.Slide.Shapes.Range(shapeCollection).Select
Select Case iShape
Case 1
MsgBox "Sorry, no shapes matching your search criteria were found"
Case Else
MsgBox "Shapes matching your search criteria were found and are selected"
End Select
NormalExit:
Exit Sub
err1:
MsgBox "You haven't selected any object"
Resume NormalExit:
End Sub