Remove Specific Shapes from the Sheet - excel

Question

Hy, I have an excel workbook consisting an Excel Sheet which contains images, shapes, arrows and many more shapes. The structure of the sheet looks like this.
In the above picture, I circle all the textboxes, arrows, Ovels, shapes which I want to delete. I have written a code to delete text boxes which are checking the existence of textboxes and if found delete them. In the other hand, if not exist show pop-up that text-box, does not exist. The code is as under.
Sub resetall()
Dim ws As Worksheet
Dim arow As Shapes
Dim txtbox As TextBox
Set ws = ActiveSheet
If ws.TextBoxes.Count < 0 Then
MsgBox "No Text Box Exist."
Exit Sub
End If
ws.TextBoxes.Delete
MsgBox "Text Box has been deleted successfully."
End Sub
This code is working fine, but I could not find the code for Arrows, and Oval Shapes, and Circles. Please check my code and guide me. I tried to use the shapes. Oval reference from the library but could not succeed. Please guide me. Thank you.

Answer 1

https://www.thespreadsheetguru.com/the-code-vault/vba-delete-all-shapes
Sub DeleteAllShapes()
'PURPOSE: Remove All Shape Objects From The Active Worksheet
'SOURCE: www.TheSpreadsheetGuru.com/the-code-vault
Dim shp As Shape
For Each shp In ActiveSheet.Shapes
shp.Delete
Next shp
End Sub
Optionally, add a test inside the loop for a specific type from msoShapeType

Answer 2

Try the next code, please:
Sub DeleteallShapesExceptRect()
Dim ws As Worksheet, s As Shape, boolRect As Boolean
Set ws = ActiveSheet
For Each s In ws.Shapes
If s.Type = msoAutoShape Then
If s.AutoShapeType = msoShapeRectangle Then
boolRect = True
End If
End If
If Not boolRect Then s.Delete
boolRect = False
Next
The next variant excepts any Rectangle shape type:
Sub DeleteallShapesExceptAllRect()
Dim ws As Worksheet, s As Shape, boolRect As Boolean
Set ws = ActiveSheet
For Each s In ws.Shapes
If s.Type = msoAutoShape Then
If s.AutoShapeType = msoShapeRectangle Or _
msoShapeRoundedRectangle Or msoShapeRound1Rectangle Or _
msoShapeSnip2DiagRectangle Then
boolRect = True
End If
End If
If Not boolRect Then s.Delete
boolRect = False
Next
End Sub
The following variant deletes all shapes from a specific range:
Sub DeleteAllShapesOnRange()
Dim ws As Worksheet, s As Shape, rngDel As Range
Set ws = ActiveSheet: Set rngDel = ws.Range("A1:W6")
For Each s In ws.Shapes
If Not Intersect(rngDel, s.TopLeftCell) Is Nothing Then
s.Delete
End If
Next
End Sub
And the next one deletes all shapes which are Not on the specific range:
Sub DeleteAllShapesNotOnRange()
Dim ws As Worksheet, s As Shape, rngNoDel As Range, boolFound As Boolean
Set ws = ActiveSheet: Set rngNoDel = ws.Range("A1:W6")
For Each s In ws.Shapes
If Not Intersect(rngNoDel, s.TopLeftCell) Is Nothing Then
boolFound = True
End If
If Not boolFound Then s.Delete
Next
End Sub
And finally, a version deleting all shapes not having text:
Sub DeleteAllShapesNotHavingText()
Dim ws As Worksheet, s As Shape, boolFound As Boolean
Set ws = ActiveSheet
For Each s In ws.Shapes
If Not Len(s.TextFrame2.TextRange.Text) = 0 Then
boolFound = True
End If
If Not boolFound Then s.Delete
Next
End Sub
Note: Each such a code is able to ask for permission before deletion, but it will not make big difference between the manual deletion and the one done in code... If you insist to have such a condition, please specify which of the above versions to be adapted.
Anyhow, the next Sub returns (in Immediate Window) all (mentioned) shapes type. You can change their names. The following code check their real type, which is returned like Long:
Sub EnumerateShapesType()
Dim ws As Worksheet, s As Shape, boolRect As Boolean, arrS As Variant, arrEl As Variant, El As Variant
arrS = Split("Rectangle|1,Round Rectangle|5,Oval|9,Right Arrow|33,Down Arrow|36", ",")
Set ws = ActiveSheet
For Each s In ws.Shapes
If s.Type = msoAutoShape Then
For Each El In arrS
If s.AutoShapeType = Split(El, "|")(1) Then
Debug.Print s.Name, Split(El, "|")(0): Exit For
End If
Next
End If
Next
End Sub

Answer 3

Office 365 answer:
Go to the Home tab
Go to Find & Select
Go to Selection Pane
You now have the names of the shapes in your worksheet.
As an example, you could use ActiveSheet.Shapes.Range(Array("Straight Arrow Connector 1")).Delete to remove a single item.