Deleting text boxes

[cart0250]

The below partial code deletes some sheets of a workbook and then delete some text-boxes from the remaining sheets. I am just wondering if there is a more efficient way to delete the shapes? Tried to set up an array but didn't work and am thinking their may be a better solution anyway?

Sub summShot()
Application.DisplayAlerts = False
Sheets(Array("G SHEET", "S SHEET", "M SHEET", "ST SHEET", "E SHEET", "N SHEET", _
"H SHEET", "P SHEET", "TR SHEET", "B SHEET")).Delete

Sheets("ben").Select
ActiveSheet.Shapes("Text Box 407").Cut
ActiveSheet.Shapes("Text Box 415").Cut
ActiveSheet.Shapes("Text Box 408").Cut
ActiveSheet.Shapes("Text Box 410").Cut
ActiveSheet.Shapes("Text Box 411").Cut
ActiveSheet.Shapes("Text Box 412").Cut

Sheets("Glen").Select
ActiveSheet.Shapes("Text Box 124").Cut
ActiveSheet.Shapes("Text Box 125").Cut
ActiveSheet.Shapes("Text Box 128").Cut
ActiveSheet.Shapes("Text Box 126").Cut
ActiveSheet.Shapes("Text Box 127").Cut

Sheets("luve").Select
ActiveSheet.Shapes("Text Box 157").Cut
ActiveSheet.Shapes("Text Box 158").Cut
ActiveSheet.Shapes("Text Box 163").Cut
ActiveSheet.Shapes("Text Box 159").Cut
ActiveSheet.Shapes("Text Box 160").Cut

....

 

[northwolves]

Dim sh as Shape
Sheets("Glen").Select 
for each sh in activesheet.shapes
if  sh.name like "Text Box 12[4-8]" then sh.cut
next

Best Regards

 

[cart0250]

Thanks. Is it possible to "select" the entire workbook, maybe through an array as used to delete the sheets, and then to use you code to delete the relevant shapes from all sheets at once rather than having to select each sheet individually?

 

[northwolves]

Of cause.
Such As:

Sub del()
Dim sh As Shape, sht As Worksheet
For Each sht In Workbooks
If sht.Name Like "*en" Then
For Each sh In sht.Shapes
If sh.Name Like "Text Box 12[4-8]" Or sh.Name Like "Text Box 4[0-1][2-8]" Then sh.Cut
Next
End If
Next
End Sub

Best Regards

 

[XLGibbs]

http://vbaexpress.com/forum/showthread.php?t=10778

Crosspost with multiple responses