(VBA) How to loop through a ShapeRange with deleted elements?

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20

Sub testIterateDeleteOverlapped()
   Dim SR As ShapeRange, shDel As New ShapeRange, s As Shape, T As Shape
   
   Set SR = ActiveLayer.Shapes.All
   
   For Each s In SR.Shapes
        For Each T In SR.Shapes
            If SR.IndexOf(s) <> SR.IndexOf(T) Then 'to avoid testing of the same shape overlapping
                If s.DisplayCurve.IntersectsWith(T.DisplayCurve) Then
                   If shDel.count > 0 Then         'if there are shapes in the shape range to be deleted
                         If shDel.IndexOf(T) = 0 Then shDel.Add s 'it checks if the shape already exists before adding it
                  Else
                        shDel.Add s                'add the shape in the shape range to be deleted
                  End If
             End If
        End If
      Next
   Next
   shDel.CreateSelection 'selecting only for testing
End Sub