Sub DeleteStoredShapes() Dim s As Shape, sr As New ShapeRange Dim v As Variant Dim Num As Long, i As Long, id As Long v = ActivePage.Properties("ShapeArray", 0) ' Retrieving the total number of shape references stored If Not IsNull(v) Then ActivePage.Properties.Delete "ShapeArray", 0 ' Delete the property Num = v ActiveDocument.ClearSelection For i = 1 To Num id = ActivePage.Properties("ShapeArray", i) ' Getting the current shape's ID to find Set s = ActivePage.FindShape(StaticID:=id) If Not s Is Nothing Then sr.Add s ' Add the shape to the shape range ActivePage.Properties.Delete "ShapeArray", i ' Delete the property Next i sr.Delete ' Delete all shapes found Else MsgBox "No shape references stored in the active page" End If End Sub