Power Point VBA Macro: Run time error 9

Question

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

Answer 1

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, ie

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