Expert: Miguel Zapico - 2/8/2008

Question
QUESTION: We have an older spreadsheet that has thousands of un-used text boxes. Is there a way to delete multiple empty text boxes at once? There are some that we use and many that are just 'out there', in order to clean up the file I'd like to only delete the blanks...

ANSWER: You use a macro for this.  For example, this one will look on the active sheet for all the shapes that are named as "Text Box" and delete the ones without any character in it.

Sub DeleteTextBoxes()
   Dim myTextBox As Shape
   
   For Each myTextBox In ActiveSheet.Shapes
       If Left(myTextBox.Name, 8) = "Text Box" Then
         If myTextBox.TextFrame.Characters.Count = 0 Then
         myTextBox.Delete
         End If
       End If
   Next
End Sub

I strongly recommend to try it first on a backup copy.

Hope this helps,
Miguel

---------- FOLLOW-UP ----------

QUESTION: This works great when there are less than 5-8k empty textboxes on a tab, but we have a few that have literally 38-40k on a single tab...and when the macro trys to work, it freezes up and I have to shut down excel...it says(Not Responding)any ideas for this type of situation?

Answer
Ok, we may try to simplify one of the IF statements with a different comparison, using the ShapeType instead of the name:

Sub DeleteTextBoxes()
  Dim myTextBox As Shape
  
  For Each myTextBox In ActiveSheet.Shapes
      If myTextBox.AutoShapeType = 1 Then
         If myTextBox.TextFrame.Characters.Count = 0 Then
         Debug.Print myTextBox.AutoShapeType
         End If
      End If
  Next
End Sub

Additionally, for the tabs with a huge amount of text boxes, you can use a For...Next loop instead of the For Each one, tweaking it to get only a fraction of the shapes.  The following sample takes the 10th part of the shapes for the checks, allowing you to save the progress between runs.  You can change that fraction at will.

Sub DeleteTextBoxesFor()
   For i = 1 To (ActiveSheet.Shapes.Count / 10)
       With ActiveSheet.Shapes(i)
         If .AutoShapeType = 1 Then
         If .TextFrame.Characters.Count = 0 Then
         Debug.Print .AutoShapeType
         End If
         End If
       End With
   Next
End Sub

Hope this helps,
Miguel