VBA Delete for Shapes Range Very Slow

[Cliff Michael]

Hello,

I am using Excel 2013 VBA Application.Intersect method to shp.Delete specific Shapes at specific cell locations, which is Worksheet Event based. It deletes a previously selected shape (or multiple shapes) before a new shape is copied and pasted in its place. It does work, however, I have noticed that the code takes longer and longer to execute over time.

For example, when I step-through the code to observe its behavior, I notice that when it gets to the Application.Intersect...shp.Delete for one shape deletion—it toggle-repeats between the shp.Delete line and Next shp line up to 75-times before moving to the next line in code. Some code lines delete up to a dozen shapes and these take even longer to execute.

I have been building and editing hundreds of lines of code in the same file for quite a while. I'm wondering if because of a great many edits there may be hidden stuff that is cluttering up the code with extra stuff. Or, otherwise, am I missing an important housekeeping method.

Thank you, cliff

Here is excerpt of code:

Sub Worksheet_Change(ByVal Target As Excel.Range)
    Application.ScreenUpdating = False
    Dim shp As Shape
 
    'First iteration of Shapes selection
    If Target.Address = "$C$4" Then
        Select Case Target.Value
            Case "FirstView"
                'Delete previously pasted shape in stated range cell location.
                For Each shp In Worksheets("Sheet2").Shapes
                    If Not Application.Intersect(shp.TopLeftCell, Worksheets("Sheet2").Range("A1,H1")) Is Nothing Then shp.Delete
                Next shp
                    'Select shape and insert to indicated cell location
                    Worksheets("Sheet1").Shapes("Shape1").Copy: Worksheets("Sheet2").Paste Destination:=Worksheets("Sheet2").Range("A1")
                    Worksheets("Sheet1").Shapes("Shape2").Copy: Worksheets("Sheet2").Paste Destination:=Worksheets("Sheet2").Range("H1")
        End Select
    End If
    Application.ScreenUpdating = True
End Sub

 

[Cliff Michael]

UPDATE:

I have determined that the number of iterations is directly correlated to the number of shapes inserted onto the worksheet. When only four shapes present, there are only four iterations. When 75 shapes present, 75 iterations and so on. I am aware that I can delete individual shapes by name. However, because I have many different shape names, which can occupy any given cell location, I must delete shapes by specific cell locations.