0
votes

So I have a Slide on PowerPoint where I have a Macro that should delete all shapes with the name that starts with "element". It does delete the shapes that I want, but not all. I have to run the macro again and then it deletes another bunch of them. So it seems not to be deleting all at once.

Can someone help me? Here's the Macro:

Sub course_reset()
Dim shp As Shape
For Each shp In Slide36.Shapes
If Left(shp.Name, 7) = "element" Then shp.Delete
Next
End Sub
2
What's happening is that the iteration is, "skipping" the entries directly after the ones that get deleted. This is a common issue when deleting objects from the collection you're iterating through. - fbueckert
OMG I just found the solution. I just figured out by experimenting that if I create a variable as a ShapeRange, set it to Slide36.Slides.Range and then do the for each for the ShapeRange, it works! Thank you anyways for the quick reply. - Daniel Clímaco
Daniel - Don't forget to post your code solution with explanation so others can find it. - QHarr

2 Answers

3
votes

The root cause of this is because of how iteration works. To illustrate:

  1. Say you're at position 42. The object at this position meets the criteria for deletion.
  2. You delete the object.
  3. Object 43 is now object 42, 44 is 43, etc., all the way down the line, to close the gap.
  4. You now move to position 43, and have skipped checking the old object 43.

The simplest way to fix this is to use a For loop starting at the end of the collection.

For i = Slide36.Shapes.Count To 1 Step -1

Then when you delete, you bypass the gap closure entirely.

1
votes

SOLUTION

I just figured out by experimenting that if I create a variable as a ShapeRange, set it to Slide36.Slides.Range and then do the for each for the ShapeRange, it works! Thank you anyways for the quick reply.

So the code would be like this:

Sub course_reset()
Dim shp As Shape
Dim shprng As ShapeRange
Set shprng = Slide36.Shapes.Range
For Each shp In shprng
If Left(shp.Name, 7) = "element" Then shp.Delete
Next
End Sub