Hi Greg,

The result was that it shrunk from 1.78 mb to 680 kb

Might be a result of code now non-compiled vs previously partly/fully
compiled, particularly if you have neither done Debug - compile nor run some
code from each module before saving (worth doing).

Time to save now 9 to 10 seconds instead of 16.

Still seems slow. I have larger project that saves faster in what I'll bet
is a much older system than yours. I notice the "linear" time difference
does not tally with what you quoted in your OP - "and at 1.04 Mb is 3
seconds".

Regards,
Peter T


"Greg Wilson" wrote in message
...
Thanks for the response. I've been using Code Cleaner for years. Didn't
help.

I broke down and rebuilt the wb. Wasn't as bad as I was expecting. I wrote
the appended code which rebuilt the worksheets excluding borders and
shapes.
Not the best I'm sure, but worked. I also repeated advice given by Jim
Cone
recently when it was acting up: http://tinyurl.com/358e9k

The result was that it shrunk from 1.78 mb to 680 kb. Time to save now 9
to
10 seconds instead of 16. Still a little slow but I think that's just the
way
it is. I am also experimenting with making the application invisible when
closing with the following snippet. This closes the application instantly
(make sure the VBE main window insn't open) and lets you do everything as
far
as I can tell short of opening a new application.

With Application
If .Workbooks.Count = 1 Then .Visible = False
End With
'code that saves wb and closes...


Code to rebuild the worksheets and named ranges. Not complete and not the
best but did the job. Create a workbook named "Rebuild" first and make
sure
it's open.

Sub CopyToNewWB()
Dim ws As Worksheet, ws2 As Worksheet
Dim c As Range, ma As Range
Dim x As Integer

With Workbooks("Rebuild.xls")
Do Until .Worksheets.Count = ThisWorkbook.Worksheets.Count
.Worksheets.Add
Loop
x = 0
For Each ws In ThisWorkbook.Worksheets
x = x + 1
Set ws2 = .Worksheets(x)
ws2.name = ws.name
If ws.name < "Time Sheet Review" Then
For Each c In ws.UsedRange.Cells
If c.MergeCells And c.Address = c.MergeArea(1, 1).Address
Then
ws2.Range(c.MergeArea.Address).MergeCells = True
FormatRng ws2.Range(c.MergeArea.Address), c.MergeArea
Else
FormatRng ws2.Range(c.Address), c.MergeArea
End If
Next
End If
Next
For Each nm In ThisWorkbook.Names
.Names.Add nm.name, nm.RefersTo
Next
End With
End Sub

Private Sub FormatRng(rng1 As Range, rng2 As Range)
With rng1(1, 1)
If .Column = 1 Then .RowHeight = rng2(1, 1).RowHeight
If .Row = 1 Then .ColumnWidth = rng2(1, 1).ColumnWidth
.Formula = rng2(1, 1).Formula
.NumberFormat = rng2(1, 1).NumberFormat
.MergeArea.Locked = rng2.Locked
.Font.Size = rng2(1, 1).Font.Size
.VerticalAlignment = rng2(1, 1).VerticalAlignment
.HorizontalAlignment = rng2(1, 1).HorizontalAlignment
.Orientation = rng2(1, 1).Orientation
.Font.Color = rng2(1, 1).Font.Color
If rng2(1, 1).Interior.ColorIndex < xlNone Then _
.Interior.ColorIndex = rng2(1, 1).Interior.ColorIndex
.Font.name = rng2(1, 1).Font.name
.Font.FontStyle = rng2(1, 1).Font.FontStyle
End With
End Sub

Regards,
Greg