All Shapes Deleter: Remove Every Text Box, Arrow, and Rectangle From an Inherited Workpaper

TL;DR: This macro scans every sheet and compiles a complete inventory of every shape — text boxes from the 2019 preparer, arrows pointing to deleted cells, rectangles someone used as a watermark. It lists them by sheet name and count, then deletes every last one on confirmation. Excel has no “select all shapes” or “delete all shapes” command. Now you do.

#Prerequisites & Setup

What you’ll need:

• Excel 2016+ (desktop)
• A workbook with floating shapes you want to remove — text boxes, arrows, rectangles, callouts, connector lines, or any drawing object

What the macro does:

• Scans every sheet in ThisWorkbook and counts every shape
• Lists affected sheets and their shape counts in a confirmation MsgBox
• On confirm, deletes every shape in the workbook in a single pass
• Reports the final count deleted

What the macro does NOT do:

• It does not delete cell data, formulas, or formatting. Shapes are floating objects — removing them does not touch anything in the grid
• It does not distinguish between shape types. Every shape on every sheet is removed. If you need to keep certain shapes, review the confirmation list carefully before clicking Yes

Limitations:

• Works on ThisWorkbook — the workbook containing the macro. Store in your Personal Macro Workbook (PERSONAL.XLSB) to run on any open file
• Protected sheets will fail. The macro attempts to delete shapes but a protected sheet blocks shape deletion. Affected sheets are reported in the final message
• Grouped shapes are handled. The macro uses SelectAll which selects everything including grouped objects. No individual ungrouping needed
• Shape formatting is deleted along with the shape. If a text box had important notes, run the review before deleting
• Shapes outside the worksheet canvas (negative coordinates, far-right columns) are still captured — ws.Shapes.Count is sheet-level, not viewport-level

#The Macro

Option Explicit

Sub DeleteAllShapes()
    ' ── All Shapes Deleter ─────────────────────────────
    ' Two-pass macro: scans every sheet for shapes,
    ' lists findings in a confirmation MsgBox, then
    ' deletes all with one click.
    '
    ' Handles all drawing objects: text boxes, arrows,
    ' rectangles, callouts, connector lines, shapes,
    ' and grouped objects. Protected sheets are
    ' skipped and reported.
    ' ────────────────────────────────────────────────────

    ' ── State management ───────────────────────────────
    Application.ScreenUpdating = False

    ' ── Variables ──────────────────────────────────────
    Dim ws As Worksheet
    Dim total As Long
    Dim sheetCount As Long
    Dim sheetList As String
    Dim protList As String
    Dim protCount As Long
    Dim deleted As Long
    Dim failCount As Long

    ' ── Error handling ─────────────────────────────────
    On Error GoTo CleanUp

    ' ═══════════════════════════════════════════════════
    ' PASS 1: Count shapes on every sheet
    ' ═══════════════════════════════════════════════════
    total = 0
    sheetCount = 0
    sheetList = ""
    protList = ""
    protCount = 0

    For Each ws In ThisWorkbook.Worksheets
        If ws.ProtectContents Then
            ' Protected — count shapes but flag as unmodifiable
            protCount = protCount + 1
            If ws.Shapes.Count > 0 Then
                protList = protList & "  • " & ws.Name & " (" & _
                           ws.Shapes.Count & " shape" & _
                           IIf(ws.Shapes.Count = 1, "", "s") & _
                           ", protected)" & vbCrLf
            End If
        ElseIf ws.Shapes.Count > 0 Then
            total = total + ws.Shapes.Count
            sheetCount = sheetCount + 1
            sheetList = sheetList & "  • " & ws.Name & " (" & _
                        ws.Shapes.Count & " shape" & _
                        IIf(ws.Shapes.Count = 1, "", "s") & ")" & vbCrLf
        End If
    Next ws

    ' ── No shapes → bail early ─────────────────────────
    If total = 0 And protList = "" Then
        MsgBox "No shapes found in this workbook.", _
               vbInformation, "All Clear"
        GoTo CleanUp
    End If

    ' ── Only protected shapes with shapes → report ─────
    If total = 0 And protList <> "" Then
        MsgBox "All shapes are on protected sheets and cannot " & _
               "be deleted:" & vbCrLf & vbCrLf & protList & vbCrLf & _
               "Unprotect these sheets first, then run again.", _
               vbExclamation, "Cannot Delete"
        GoTo CleanUp
    End If

    ' ═══════════════════════════════════════════════════
    ' Build confirmation message
    ' ═══════════════════════════════════════════════════
    Dim confirmMsg As String
    confirmMsg = "Found " & total & " shape(s) across " & _
                 sheetCount & " sheet(s):" & vbCrLf & vbCrLf & sheetList

    If protList <> "" Then
        confirmMsg = confirmMsg & vbCrLf & _
                     "These protected sheets will be SKIPPED:" & vbCrLf & _
                     protList
    End If

    confirmMsg = confirmMsg & vbCrLf & _
                 "Delete ALL shapes? This cannot be undone."

    ' ── Ask for confirmation ──────────────────────────
    If MsgBox(confirmMsg, vbExclamation + vbYesNo, _
              "Confirm Shape Deletion") = vbNo Then
        MsgBox "No shapes were deleted.", vbInformation, "Cancelled"
        GoTo CleanUp
    End If

    ' ═══════════════════════════════════════════════════
    ' PASS 2: Delete all shapes
    ' ═══════════════════════════════════════════════════
    deleted = 0
    failCount = 0

    For Each ws In ThisWorkbook.Worksheets
        If Not ws.ProtectContents And ws.Shapes.Count > 0 Then
            On Error Resume Next
            ws.Shapes.SelectAll
            Selection.Delete
            If Err.Number = 0 Then
                deleted = deleted + 1
            Else
                failCount = failCount + 1
            End If
            On Error GoTo CleanUp
        End If
    Next ws

    ' ═══════════════════════════════════════════════════
    ' Final report
    ' ═══════════════════════════════════════════════════
    Dim resultMsg As String
    resultMsg = "Deleted " & total & " shape(s) from " & _
                deleted & " sheet(s)."

    If protCount > 0 Then
        resultMsg = resultMsg & vbCrLf & protCount & _
                    " protected sheet(s) skipped."
    End If

    If failCount > 0 Then
        resultMsg = resultMsg & vbCrLf & failCount & _
                    " sheet(s) failed (may have grouped or " & _
                    "protected objects)."
    End If

    MsgBox resultMsg, vbInformation, "Done"

CleanUp:
    Application.ScreenUpdating = True

    If Err.Number <> 0 Then
        MsgBox "Error " & Err.Number & ": " & Err.Description & _
               vbCrLf & vbCrLf & _
               "A sheet may be protected or contain shapes " & _
               "that cannot be deleted. Try unprotecting all " & _
               "sheets and running again.", _
               vbCritical, "Macro Error"
    End If
End Sub

#How It Works

#Count first, delete second

Like every destructive macro on this site, the macro runs two passes. The first pass is read-only — it counts ws.Shapes.Count on every sheet without touching anything:

If ws.Shapes.Count > 0 Then
    total = total + ws.Shapes.Count
    sheetCount = sheetCount + 1
    sheetList = sheetList & "  • " & ws.Name & " (" & _
                ws.Shapes.Count & " shape" & _
                IIf(ws.Shapes.Count = 1, "", "s") & ")" & vbCrLf
End If

This builds a complete inventory — every sheet name, every shape count — before any deletion happens. The confirmation message shows you the exact list. If you see the “Notes” sheet with 8 shapes and you know those are the partner’s review callouts you want to keep, you can cancel with zero consequences.

#Protected sheets: counted, flagged, skipped

Some workpapers have locked sheets to prevent accidental changes. The macro detects protection and handles it gracefully:

If ws.ProtectContents Then
    protCount = protCount + 1
    If ws.Shapes.Count > 0 Then
        protList = protList & "  • " & ws.Name & " (" & _
                   ws.Shapes.Count & " shape(s), protected)" & vbCrLf
    End If

Protected sheets appear in the confirmation message with a “(protected)” tag. They’re counted so you’re aware the shapes exist, but they’re skipped during the deletion pass. The final report tells you how many were skipped. Unprotect those sheets and run the macro again to finish the job.

#The ws.Shapes.SelectAll method handles everything

The actual deletion is two lines:

ws.Shapes.SelectAll
Selection.Delete

ws.Shapes.SelectAll is the VBA equivalent of pressing Ctrl+A while focused on the worksheet canvas — it selects every shape, chart, SmartArt, text box, rectangle, arrow, connector, callout, and group. Grouped shapes are selected as a unit, not as individual objects inside the group, so the .Delete call works on the group container directly.

This is the same operation as the Selection Pane (Home → Find & Select → Selection Pane) — but applied to every sheet in the workbook, not one sheet at a time.

#Why the confirmation uses vbExclamation

If MsgBox(confirmMsg, vbExclamation + vbYesNo, _
          "Confirm Shape Deletion") = vbNo Then

vbExclamation displays a yellow warning triangle, not a blue question mark (vbQuestion). The distinction is intentional: a question mark suggests a routine operation where you can safely click through. A warning icon says “this is destructive, pay attention.” Deleting shapes is permanent — VBA has no undo button — so the warning icon is the responsible choice.

#ScreenUpdating off, Calculation untouched

The macro toggles Application.ScreenUpdating = False to prevent the visible flickering that happens when shapes are selected and deleted across multiple sheets. Without it, Excel redraws each sheet as every shape blinks out of existence — not harmful, but visually disorienting on a 20-tab workbook.

Application.Calculation is left at its current setting. Deleting shapes does not change any cell value, so no formulas need to recalculate. Toggling Calculation off would add two lines for zero benefit.

#Shapes on ALL sheets, not just visible ones

The For Each ws In ThisWorkbook.Worksheets loop processes every sheet — including hidden and very-hidden sheets. The prior preparer may have hidden a reference sheet that still holds leftover text boxes. The macro finds them regardless of visibility state.

If you want to skip hidden sheets, add a ws.Visible check:

If ws.Visible <> xlSheetVisible Then GoTo NextSheet

But the default behavior of scanning everything is intentionally thorough. Hidden shapes on hidden sheets are still data — and when you’re cleaning an inherited workbook, you want to clean everything.

#No Calculation toggle — same reason as the filter remover

This macro doesn’t write to any cells or change any values. It only deletes shape objects from the sheet’s shape collection. No formulas recalculate, no values shift, no cell contents change. Toggling Application.Calculation would add two lines for zero benefit.

#Adapt It