File size growing growing exponentially
 

I have a file that has been growing and now is over 8 MB. I checked lots of
things from similar discussions and when I ran this from Ron de Bruin it went
from 8.31MB to 822 KB

Sub Shapes1()
'Delete all Objects except Comments
On Error Resume Next
ActiveSheet.DrawingObjects.Visible = True
ActiveSheet.DrawingObjects.Delete
On Error GoTo 0
End Sub

So on the original worksheet tabs I tried this from another discussion

?activesheet.shapes.count
10439
?activesheet.shapes.count
20567

No wonder! I should have zero on the first one and 20 (buttons which have
"send report" on the face and are tied to macros) on the second one.

How can I adapt the "Shapes Deleting" macro to not eliminate the ones I want
when try to get rid of the other 20547 on the one sheet?

File size growing growing exponentially
 

Dear Steve

Mention the 20 shape names as a comma separated string...like below and run
the below macro.... Make sure the names are exactly same as the shape
names....For example the by default name for Rectangle come as 'Rectangle 1'
and not 'Rectangle1'...Try and feedback


Sub Macro()
Dim lngTemp As Variant
Dim strShapes As String

strShapes = "Rectagle 10,Rectangle 2,Rectangle 31"
strShapes = strShapes & ",Rectagle 32,Rectangle 35,Rectangle 70"


For lngTemp = 1 To ActiveSheet.Shapes.Count
If InStr(1, "," & strShapes & ",", "," & ActiveSheet. _
Shapes(lngTemp).Name & ",", vbTextCompare) = 0 Then
ActiveSheet.Shapes(lngTemp).Delete
End If
Next
End Sub

--
If this post helps click Yes
---------------
Jacob Skaria


"Steve" wrote:

I have a file that has been growing and now is over 8 MB. I checked lots of
things from similar discussions and when I ran this from Ron de Bruin it went
from 8.31MB to 822 KB

Sub Shapes1()
'Delete all Objects except Comments
On Error Resume Next
ActiveSheet.DrawingObjects.Visible = True
ActiveSheet.DrawingObjects.Delete
On Error GoTo 0
End Sub

So on the original worksheet tabs I tried this from another discussion

?activesheet.shapes.count
10439
?activesheet.shapes.count
20567

No wonder! I should have zero on the first one and 20 (buttons which have
"send report" on the face and are tied to macros) on the second one.

How can I adapt the "Shapes Deleting" macro to not eliminate the ones I want
when try to get rid of the other 20547 on the one sheet?

File size growing growing exponentially
 

The first one should make a list for you on a clean worksheet. Then, put an
x in col c of that sheet and run the second.

Sub makelistofshapes()
r = 2
For Each sh In Sheets("yoursheetnamehere").Shapes
Cells(r, 1) = sh.Name
Cells(r, 2) = sh.TopLeftCell.Address
r = r + 1
Next sh
End Sub

Sub deleteselectedshapes()
On Error Resume Next
For Each c In Range("a2:a22")
If UCase(c.Offset(, 2)) = "X" Then
Sheets("yoursheetnamehere").Shapes(c).Cut
End If
Next
End Sub


--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"Steve" wrote in message
...
I have a file that has been growing and now is over 8 MB. I checked lots
of
things from similar discussions and when I ran this from Ron de Bruin it
went
from 8.31MB to 822 KB

Sub Shapes1()
'Delete all Objects except Comments
On Error Resume Next
ActiveSheet.DrawingObjects.Visible = True
ActiveSheet.DrawingObjects.Delete
On Error GoTo 0
End Sub

So on the original worksheet tabs I tried this from another discussion

?activesheet.shapes.count
10439
?activesheet.shapes.count
20567

No wonder! I should have zero on the first one and 20 (buttons which have
"send report" on the face and are tied to macros) on the second one.

How can I adapt the "Shapes Deleting" macro to not eliminate the ones I
want
when try to get rid of the other 20547 on the one sheet?

File size growing growing exponentially
 

Another way is to select the cell range of shapes which are to be kept...The
below macro will remove all other shapes from the Active worksheet.

Sub RemoveShapes()
Dim rngMyRange As Range
Dim shpMyShape As Shape
Set rngMyRange = Selection
For Each shpMyShape In ActiveSheet.Shapes
If Application.Intersect(rngMyRange, shpMyShape.TopLeftCell) _
Is Nothing Then shpMyShape.Delete
Next shpMyShape
End Sub

--
If this post helps click Yes
---------------
Jacob Skaria


"Steve" wrote:

I have a file that has been growing and now is over 8 MB. I checked lots of
things from similar discussions and when I ran this from Ron de Bruin it went
from 8.31MB to 822 KB

Sub Shapes1()
'Delete all Objects except Comments
On Error Resume Next
ActiveSheet.DrawingObjects.Visible = True
ActiveSheet.DrawingObjects.Delete
On Error GoTo 0
End Sub

So on the original worksheet tabs I tried this from another discussion

?activesheet.shapes.count
10439
?activesheet.shapes.count
20567

No wonder! I should have zero on the first one and 20 (buttons which have
"send report" on the face and are tied to macros) on the second one.

How can I adapt the "Shapes Deleting" macro to not eliminate the ones I want
when try to get rid of the other 20547 on the one sheet?