VBA Powerpoint: Delete Shape with specific text. Run-time error '-2147024809 (80070057)': The specified value is out of range

I have a very long ppt presentation (about 850 slides) and the second half is full of shapes with certain text that I would like to delete. Sadly, it appears that is has nothing to do with the Slide Master, so I can't use that.

I got an error:

Run-time error '-2147024809 (80070057)': 
The specified value is out of range

Here's the code, I got at the moment

Sub DeleteShapeWithSpecTxt()


Dim oSl As Slides, oSh As Shapes, oTr As TextRange
Dim str As String
Dim testcomp1, testcomp2
Dim lppt, ShapeNb, k, j As Long
Dim pptAct
Set pptAct = PowerPoint.ActivePresentation


str = pptAct.Slides(335).Shapes(4).TextFrame.TextRange.Text
lppt = pptAct.Slides.Count




For k = 1 To lppt
    ShapeNb = pptAct.Slides(k).Shapes.Count
    For j = 1 To ShapeNb
        If pptAct.Slides(k).Shapes(j).HasTextFrame And StrComp(str, pptAct.Slides(k).Shapes(j).TextFrame.TextRange.Text) = 0 Then
            pptAct.Slides(k).Shapes(j).Delete
        End If
    Next
Next

End Sub

Solution

There are several reasons this code could raise an error. Firstly, if slide 335 or shape 4 doesn't exist (try to make those numbers dynamic or handle errors). Next, your If line will evaluate both parts so if the shape doesn't have a TextFrame, VBA will still try to evaluate the second part and hence raise an error. Finally, you also need to count backwards in any object collection that you may delete objects. You could also simplify this using the For Each Next construct and optionally pass the search text to the procedure from your main code:

Sub DeleteShapeWithSpecTxt(Optional sSearch As String)
  Dim oSld As Slide
  Dim oShp As Shape
  Dim lShp As Long

  On Error GoTo errorhandler
  If sSearch = "" Then sSearch = ActivePresentation.Slides(335).Shapes(4).TextFrame.TextRange.Text

  For Each oSld In ActivePresentation.Slides
    ' I would usually use the next line to loop through all shapes on the slide but can't in this case as shapes may be deleted
    'For Each oShp In oSld.Shapes
    For lShp = oSld.Shapes.Count To 1 Step -1
      With oSld.Shapes(lShp)
        If .HasTextFrame Then
          If StrComp(sSearch, .TextFrame.TextRange.Text) = 0 Then .Delete
        End If
      End With
    Next
  Next
Exit Sub
errorhandler:
  Debug.Print "Error in DeleteShapeWithSpecTxt : " & Err & ": " & Err.Description
  On Error GoTo 0
End Sub

If you want to make the search text dynamic, this is a nice simple method. Just replace the If sSearch = ""... line with this:

If sSearch = "" Then sSearch = InputBox("Enter test to search for and all shapes matching the text will be deleted across this presentation:","Delete Matching Shapes","test")