Remove shape in specific range

[FilleFrella44]

Hello,

I'm new to the forum. I've got a sheet where there sometimes exists shapes which cannot be targeted by the mouse (there are several different ones, they're not all the same shape).

I want to be able to remove them anyway, however I want to also control which ones I remove since some of them I still want in the sheet.

Hence, I am trying a code where I can remove shapes based on the selected area in the Excel Sheet. Currently I've come to this code (with inspiration from other forumposts):

Sub Remove_Shapes_In_Range()

Dim shp As Shape, i As Long

'This is just to make the user select the range themselves (i.e. me)
Set myRng = Application.InputBox( _
prompt:="Select a cell or range or cells", Type:=8)
Debug.Print myRng.Address 'remove when you are happy

'Here I try to remove the shape in the selected range
If shp.myRng Then shp.Delete

End Sub

 

[FilleFrella44]

I have previusly used code which removes all shapes, however now I'm not so sure that's the best idea, since some of the shapes are quite important and macros makes me unable to go backwards.

Sub DeleteAllShapes()
'PURPOSE: Remove All Shape Objects From The Active Worksheet
'SOURCE: www.TheSpreadsheetGuru.com/the-code-vault

' RemoveImages Macro
' Removes icones from inserted documents.

Dim shp As Shape

For Each shp In ActiveSheet.Shapes
shp.Delete
Next shp

End Sub

 

[dmt32]

Hi
your second code can be modified to work in way required by adding an array of shapes to exclude from being deleted

Sub DeleteAllShapes()
    Dim shp As Shape
    Dim keepShape As Variant
    
    keepShape = Array("shape1", "shape2", "shape3")
    
    For Each shp In ActiveSheet.Shapes
        If IsError(Application.Match(shp.Name, keepShape, 0)) Then shp.Delete
    Next shp

End Sub

Change the shape names in bold as required

Dave

 

[FilleFrella44]

Hi and thanks for the quick reply!

I believe this needs me to know the name of the shapes which I want to keep? Currently they are untargetable with the mouse, so I'm not sure how I'll get the name of the shape.

Is "shape names" referring to something else, or is the name of the shape?

 

[Perpa]

FF44,
Perhaps this method will allow you to select which shapes you want to delete.
Good luck.
Perpa

Sub SelectShapesToDelete()
Dim shp As Excel.Shape
Dim ws As Worksheet
Dim ans As Integer

On Error Resume Next

Set ws = ActiveSheet
For Each shp In ws.Shapes
    shp.TopLeftCell.Select   'Brings the Shape into view
    ans = InputBox("Enter 1 to DELETE SHAPE" & vbLf & vbLf & "'CANCEL' - DON'T DELETE SHAPE", shp.Name)
    Select Case ans
        Case 1  'Yes, Delete this Shape
            shp.Delete
    End Select
Passem:
Cells(13, 1).Select
Next
End Sub

 

[dmt32]

I believe this needs me to know the name of the shapes which I want to keep?

Correct,
you specify the name of each shape the code needs to ignore in the array.

what is it that prevents you from selecting shapes?

Dave

 

[FilleFrella44]

@dmt32 the reason that I cannot "selecting" them is that nothing happens if I click on them. The mouse recognizes the shape by changing the cursor to a "hand-click-mark" instead of the standard-arrow, however when clicked it does not activate the shape. Hence, I don't know how to get the name of the shape. Perhaps there's a VBA workaround?

@Perpa This is a decent solution, however, gets quite tedious with hundreds of shapes. But it works as a work-around at the moment.

But is it difficult / not possible to activate only shapes inside of a selected range and execute the .Delete on only those shapes in Excel / VBA?

Thanks very much for the support thus far, it is of great help.

 

[RoryA]

You'd need a loop - something like:

For each shp in activesheet.shapes
If Not Intersect(shp.TopLeftcell, myRng) is nothing Then shp.Delete
next shp

 

[FilleFrella44]

@RoryA Interesting, I tried to implement it like this but could not debug it properly.

PS: How do you enter the code so that it looks like code in the comment? Just for kicks.

Sub ShapeTest()

Dim shp As Shape
Dim myRng As Range

For Each shp In ActiveSheet.Shapes
If Not Intersect(shp.TopLeftCell, myRng) Is Nothing Then shp.Delete
Next shp

End Sub

 

[RoryA]

Select the code then use the toolbar button(s) as appropriate:

You forgot the part to set the range from your prior code:

Set myRng = Application.InputBox( _
prompt:="Select a cell or range or cells", Type:=8)