Slow Performance after Saving file in "Excel 97-2003" format

[PoggiPJ]

My 2003 xls workbook performs fine. I save and send it to a 2010 user who (after a couple of minor edits) then saves the workbook in Excel 97-2003 format and returns it back to me. When I open the updated workbook it takes 10 minutes to open, and any change I make takes several minutes to process. Stranger stiill, he and I used to exchange the same files with NO issues. Any idea what could be happening?

 

[sijpie]

Have you looked at the file sizes? Are they a lot larger when you get them back?

 

[PoggiPJ]

Have you looked at the file sizes? Are they a lot larger when you get them back?

Well here's the strange thing. I have another user who has both Excel 2010 and 2003 on his laptop. When he opens the file using 2010 it opens in seconds. When he opens the same file with 2003, it runs endlessly.

 

[chuckchuckit]

If the file size is growing, and the speed is slower, it can be due to queries being done.

Try below code on each worksheet (you will have to change the name in code below for each worksheet). It will not harm anything if there are no queries there.

Sub QueryTablesDeleteAllIn_Sheet1()
[COLOR=#008000]'Filesize grows (when you save it) due to Excel keeps track in background the path of each query table
'so each individual query will grow the filesize bigger.
'So delete them all after you process data from a query.[/COLOR]

    Dim i As Integer
    With Worksheets("Sheet1")
        For i = .QueryTables.Count To 1 Step -1
            .QueryTables(i).Delete
        Next
    End With

End Sub

 

[PoggiPJ]

If the file size is growing, and the speed is slower, it can be due to queries being done.

Try below code on each worksheet (you will have to change the name in code below for each worksheet). It will not harm anything if there are no queries there.

Sub QueryTablesDeleteAllIn_Sheet1()
[COLOR=#008000]'Filesize grows (when you save it) due to Excel keeps track in background the path of each query table
'so each individual query will grow the filesize bigger.
'So delete them all after you process data from a query.[/COLOR]

    Dim i As Integer
    With Worksheets("Sheet1")
        For i = .QueryTables.Count To 1 Step -1
            .QueryTables(i).Delete
        Next
    End With

End Sub

Chuck, my apologies, I became distracted with another project and never got back to you.
Yes, the size is growing - by almost 30%.
I did apply the code you provided, and following the execution I could see that it was deleting QueryTables. After running it, the file performance improved slightly but did not shrink in size.
There is still a significant degradation executing under 2003. Any other suggestions would be appreciated.

 

[MARK858]

Does the used range on each sheet match what you would expect it to be based on your data?
If you are not sure run the code below on each sheet.

Sub URange()
MsgBox "Used Range is: " & ActiveSheet.UsedRange.Address, , "Used Range"
End Sub

 

[PoggiPJ]

Does the used range on each sheet match what you would expect it to be based on your data?
If you are not sure run the code below on each sheet.

Sub URange()
MsgBox "Used Range is: " & ActiveSheet.UsedRange.Address, , "Used Range"
End Sub

Hi, thank you for that. I ran it, and yes. There were a couple of sheets with a depth of 35+K and 40K rows, but they are both long parts catalogs.

What would happen if the Excel 2010 user was operating in 64 bits, and was saving it as excel 97-2003? Would you expect that to make a difference?

 

[MARK858]

What would happen if the Excel 2010 user was operating in 64 bits, and was saving it as excel 97-2003? Would you expect that to make a difference?

I run Excel 32 bit on a 64 bit computer and don't get an issue but I have very limited experience at running Excel 64 bit and so I can't really comment on that.
Try running the code below (on a copy of your workbook) by ZVI and see if it helps reduce the file size

Sub MrExcelDiet()
' ZVI:2009-08-08 Active workbook excess formatting clearing
' Idea & original code of Just_Jon: excel file huge
' First attempt of modification: Large, Slow Excel Workbook
' Revision 2010-06-16: Sizes of comments shapes are ignored, StandardHeight part is corrected
  Const Title = "MrExcelDiet: Just_Jon's code modified by ZVI"
  Const vbTab2 = vbTab & vbTab
  Dim Wb As Workbook, Ws As Worksheet, lastcell As Range, Shp As Shape, Chrt As Chart
  Dim Prot As Boolean, ProtWarning As Boolean, DoCharts As Boolean
  Dim LastRow&, LastCol&, ShpLastRow&, ShpLastCol&, I&, ac, x
  Dim SheetsTotal&, SheetsCleared&, ChartsCleared&, SheetsProtSkipped&
  Dim FileNameTmp$, BytesInFileOld&, BytesInFileNew&
  ' Choose the clearing mode
  Set Wb = ActiveWorkbook
  x = MsgBox("Excess formatting clearing of " & Wb.Name & vbLf & vbLf & _
             "Apply full clearing?" & vbLf & vbLf & _
             "Yes" & vbTab & "- Full mode, including chart's AutoScaleFont=False" & vbLf & _
             "No" & vbTab & "- Medium mode, without charts processing" & vbLf & _
             "Cancel" & vbTab & "- Stop clearing & Exit", _
             vbInformation + vbYesNoCancel, _
             Title)
  If x = vbCancel Then Exit Sub
  DoCharts = (x = vbYes)
  ' Freeze on
  With Application
    .ScreenUpdating = False
    .EnableEvents = False
    ac = .Calculation: .Calculation = xlCalculationManual
  End With
  ' Calculate the old file size
  On Error Resume Next
  With CreateObject("Scripting.FileSystemObject")
    FileNameTmp = .GetSpecialFolder(2) & "\" & Wb.Name & ".TMP"
    Wb.SaveCopyAs FileNameTmp
    BytesInFileOld = .GetFile(FileNameTmp).Size
  End With
  ' Processing in each worksheet
  ProtWarning = True
  SheetsTotal = Wb.Sheets.Count
  For Each Ws In Wb.Worksheets
    With Ws
      ' Clear an error flag
      Err.Clear
      ' Inform on processing status
      Application.StatusBar = "MrExcelDiet: processing of sheet " & Ws.Name
      ' Check protection
      Prot = .ProtectContents
      ' Try to unprotect without password
      If Prot Then .Unprotect ""
      If (Err <> 0 Or .ProtectContents) And ProtWarning Then
        SheetsProtSkipped = SheetsProtSkipped + 1
        x = MsgBox(Ws.Name & " is protected and will be skipped" & vbLf & vbLf & _
                   "Skip warning on protected sheets?" & vbLf & vbLf & _
                   "Yes" & vbTab & "- Skip warning, clear sheets silently" & vbLf & _
                   "No" & vbTab & "- Warning on each protected sheets" & vbLf & _
                   "Cancel" & vbTab & "- Stop clearing & Exit", _
                   vbExclamation + vbYesNoCancel, _
                   Title)
        ProtWarning = (x = vbNo)
        If x = vbCancel Then GoTo exit_
      Else
        ' Count processed worksheets
        SheetsCleared = SheetsCleared + 1
        ' Determine the last used cell with a formula or value or comment in Ws
        Set lastcell = GetLastCell(Ws)
        ' Determine the last column and last row
        If Not lastcell Is Nothing Then
          LastCol = lastcell.Column
          LastRow = lastcell.Row
        End If
        ' Determine if any merged cells are beyond the last row
        For Each x In Range(.Cells(LastRow, 1), .Cells(LastRow, LastCol))
          If x.MergeCells Then
            With x.MergeArea
              LastRow = Max(LastRow, .Rows(.Rows.Count).Row)
            End With
          End If
        Next
        ' Determine if any merged cells are beyond the last column
        For Each x In Range(.Cells(1, LastCol), .Cells(LastRow, LastCol))
          If x.MergeCells Then
            With x.MergeArea
              LastCol = Max(LastCol, .Columns(.Columns.Count).Column)
            End With
          End If
        Next
        ' Determine if any shapes are beyond the last row and last column
        ShpLastCol = LastCol
        ShpLastRow = LastRow
        For Each Shp In .Shapes
          If Shp.Type <> msoComment Then  ' ZVI:2010-06-16
            ShpLastCol = Max(ShpLastCol, Shp.BottomRightCell.Column)
            ShpLastRow = Max(ShpLastRow, Shp.BottomRightCell.Row)
          End If
        Next
        ' Clear cells beyond the last column
        If LastCol < .Columns.Count Then
          With .Range(.Columns(LastCol + 1), .Columns(.Columns.Count))
            .Clear
            If LastCol >= ShpLastCol Then
              ' Set StandardWidth to columns which are beyond the last col
              .EntireColumn.ColumnWidth = IIf(Ws.StandardWidth, Ws.StandardWidth, 8.43) 'Ws.StandardWidth
            End If
          End With
          If ShpLastCol < .Columns.Count Then
            ' Set StandardWidth to columns which are beyond the Shapes
            With .Range(.Columns(ShpLastCol + 1), .Columns(.Columns.Count))
              .EntireColumn.ColumnWidth = IIf(.StandardWidth, .StandardWidth, 8.43) 'Ws.StandardWidth
            End With
          End If
        End If
        ' Clear cells beyond the last row
        If LastRow < .Rows.Count Then
          With .Range(.Rows(LastRow + 1), .Rows(.Rows.Count))
            .Clear
            If LastRow >= ShpLastRow Then
              ' Set StandardWidth to rows which are beyond the last row
              .EntireRow.RowHeight = IIf(Ws.StandardHeight, Ws.StandardHeight, 12.75)
            End If
          End With
          If ShpLastRow < .Rows.Count Then
            ' Set StandardHeight to rows which are beyond the Shapes
            With .Range(.Rows(ShpLastRow + 1), .Rows(.Rows.Count))
              .EntireRow.RowHeight = IIf(.StandardHeight, .StandardHeight, 12.75)
            End With
          End If
        End If
        ' Reset last cell position of the sheet
        With .UsedRange: End With
        ' Protect the sheet if it was unprotected
        If Prot Then .Protect
      End If
      ' Apply setting to worksheet's charts: ChartArea.AutoScaleFont = False
      If DoCharts Then
        For I = 1 To .ChartObjects.Count
          Application.StatusBar = "MrExcelDiet: processing of chart " & .ChartObjects(I).Name
          .ChartObjects(I).Chart.ChartArea.AutoScaleFont = False
          ChartsCleared = ChartsCleared + 1
        Next
      End If
    End With
  Next
  ' Apply setting to workbook's charts: ChartArea.AutoScaleFont = False
  If DoCharts Then
    With Wb
      For I = 1 To .Charts.Count
        ' Clear an error flag
        Err.Clear
        ' Inform on processing status
        Application.StatusBar = "MrExcelDiet: processing of chart " & .Charts(I).Name
        ' Check chart sheet protection
        Prot = .Charts(I).ProtectContents
        ' Try to unprotect chart sheet without password
        If Prot Then .Charts(I).Unprotect ""
        If (Err <> 0 Or .Charts(I).ProtectContents) And ProtWarning Then
          SheetsProtSkipped = SheetsProtSkipped + 1
          x = MsgBox(Ws.Name & " is protected and will be skipped" & vbLf & vbLf & _
                     "Skip warning on protected sheets?" & vbLf & vbLf & _
                     "Yes" & vbTab & "- Skip warning, clear sheets silently" & vbLf & _
                     "No" & vbTab & "- Warning on each protected sheets" & vbLf & _
                     "Cancel" & vbTab & "- Stop clearing & Exit", _
                     vbExclamation + vbYesNoCancel, _
                     Title)
          ProtWarning = (x = vbNo)
          If x = vbCancel Then GoTo exit_
        Else
          ' Set AutoScaleFont = False for chart sheet
          .Charts(I).ChartArea.AutoScaleFont = False
          SheetsCleared = SheetsCleared + 1
          ChartsCleared = ChartsCleared + 1
          ' Protect the chart sheet if it was unprotected
          If Prot Then .Charts(I).Protect
        End If
      Next
    End With
  End If
exit_:
  ' Calculate the new file size
  Wb.SaveCopyAs FileNameTmp
  BytesInFileNew = CreateObject("Scripting.FileSystemObject").GetFile(FileNameTmp).Size
  Kill FileNameTmp
  ' Freeze off
  With Application
    .Calculation = ac
    .ScreenUpdating = True
    .EnableEvents = True
  End With
  ' Report on results
  Application.StatusBar = False
  x = MsgBox("Statistics of excess formatting clearing" & vbLf & vbLf & _
             "Workbook:" & vbTab & ActiveWorkbook.Name & vbLf & _
             "Sheets total:" & vbTab2 & SheetsTotal & vbLf & _
             "Sheets cleared:" & vbTab2 & SheetsCleared & vbLf & _
             "Protected sheets skipped: " & vbTab & SheetsProtSkipped & vbLf & _
             "Other sheets skipped:" & vbTab & SheetsTotal - SheetsCleared - SheetsProtSkipped & vbLf & _
             "Charts cleared:" & vbTab2 & ChartsCleared & vbLf & _
             "File size old:" & vbTab & Format(BytesInFileOld, "# ### ##0") & " Bytes" & vbLf & _
             "File size new:" & vbTab & Format(BytesInFileNew, "# ### ##0") & " Bytes" & vbLf & _
             vbLf & _
             "Save the cleared workbook to keep the changes?" & vbLf & _
             "Yes" & vbTab & "- Save & Exit" & vbLf & _
             "No" & vbTab & "- Exit without saving, cleared", _
             vbInformation + vbYesNo + IIf(BytesInFileNew < BytesInFileOld, vbDefaultButton1, vbDefaultButton2), _
             Title)
  If x = vbYes Then Wb.Save
End Sub


' ZVI:2009-02-02 Get last cell within values/formulas/comments of sheet Sh
' Auto-filtered & hidden rows/columns are also calculated without ShowAllData
' ActiveSheet is used if optional Sh is missing
' If VisibleOnly=True then only visible cells are searched
Function GetLastCell(Optional Sh As Worksheet, Optional VisibleOnly As Boolean) As Range
  Dim SpecCells(), rng As Range, R&, c&, x, a
  SpecCells = Array(xlCellTypeConstants, xlCellTypeFormulas, xlCellTypeComments)
  On Error Resume Next
  If Sh Is Nothing Then Set Sh = ActiveSheet
  Set rng = Sh.UsedRange
  If VisibleOnly Then Set rng = rng.SpecialCells(xlCellTypeVisible)
  For Each x In SpecCells
    For Each a In rng.SpecialCells(x).Areas
      With a.Cells(a.Rows.Count, a.Columns.Count)
        c = Max(c, .Column)
        R = Max(R, .Row)
      End With
    Next
  Next
  If R * c <> 0 Then Set GetLastCell = Sh.Cells(R, c)
End Function


' Aux function: max value of arguments
Private Function Max(ParamArray Values())
  Dim x
  For Each x In Values
    If x > Max Then Max = x
  Next
End Function

 

[PoggiPJ]

I run Excel 32 bit on a 64 bit computer and don't get an issue but I have very limited experience at running Excel 64 bit and so I can't really comment on that.
Try running the code below (on a copy of your workbook) by ZVI and see if it helps reduce the file size

Sub MrExcelDiet()
' ZVI:2009-08-08 Active workbook excess formatting clearing
' Idea & original code of Just_Jon: excel file huge
' First attempt of modification: Large, Slow Excel Workbook
' Revision 2010-06-16: Sizes of comments shapes are ignored, StandardHeight part is corrected
  Const Title = "MrExcelDiet: Just_Jon's code modified by ZVI"
  Const vbTab2 = vbTab & vbTab
  Dim Wb As Workbook, Ws As Worksheet, lastcell As Range, Shp As Shape, Chrt As Chart
  Dim Prot As Boolean, ProtWarning As Boolean, DoCharts As Boolean
  Dim LastRow&, LastCol&, ShpLastRow&, ShpLastCol&, I&, ac, x
  Dim SheetsTotal&, SheetsCleared&, ChartsCleared&, SheetsProtSkipped&
  Dim FileNameTmp$, BytesInFileOld&, BytesInFileNew&
  ' Choose the clearing mode
  Set Wb = ActiveWorkbook
  x = MsgBox("Excess formatting clearing of " & Wb.Name & vbLf & vbLf & _
             "Apply full clearing?" & vbLf & vbLf & _
             "Yes" & vbTab & "- Full mode, including chart's AutoScaleFont=False" & vbLf & _
             "No" & vbTab & "- Medium mode, without charts processing" & vbLf & _
             "Cancel" & vbTab & "- Stop clearing & Exit", _
             vbInformation + vbYesNoCancel, _
             Title)
  If x = vbCancel Then Exit Sub
  DoCharts = (x = vbYes)
  ' Freeze on
  With Application
    .ScreenUpdating = False
    .EnableEvents = False
    ac = .Calculation: .Calculation = xlCalculationManual
  End With
  ' Calculate the old file size
  On Error Resume Next
  With CreateObject("Scripting.FileSystemObject")
    FileNameTmp = .GetSpecialFolder(2) & "\" & Wb.Name & ".TMP"
    Wb.SaveCopyAs FileNameTmp
    BytesInFileOld = .GetFile(FileNameTmp).Size
  End With
  ' Processing in each worksheet
  ProtWarning = True
  SheetsTotal = Wb.Sheets.Count
  For Each Ws In Wb.Worksheets
    With Ws
      ' Clear an error flag
      Err.Clear
      ' Inform on processing status
      Application.StatusBar = "MrExcelDiet: processing of sheet " & Ws.Name
      ' Check protection
      Prot = .ProtectContents
      ' Try to unprotect without password
      If Prot Then .Unprotect ""
      If (Err <> 0 Or .ProtectContents) And ProtWarning Then
        SheetsProtSkipped = SheetsProtSkipped + 1
        x = MsgBox(Ws.Name & " is protected and will be skipped" & vbLf & vbLf & _
                   "Skip warning on protected sheets?" & vbLf & vbLf & _
                   "Yes" & vbTab & "- Skip warning, clear sheets silently" & vbLf & _
                   "No" & vbTab & "- Warning on each protected sheets" & vbLf & _
                   "Cancel" & vbTab & "- Stop clearing & Exit", _
                   vbExclamation + vbYesNoCancel, _
                   Title)
        ProtWarning = (x = vbNo)
        If x = vbCancel Then GoTo exit_
      Else
        ' Count processed worksheets
        SheetsCleared = SheetsCleared + 1
        ' Determine the last used cell with a formula or value or comment in Ws
        Set lastcell = GetLastCell(Ws)
        ' Determine the last column and last row
        If Not lastcell Is Nothing Then
          LastCol = lastcell.Column
          LastRow = lastcell.Row
        End If
        ' Determine if any merged cells are beyond the last row
        For Each x In Range(.Cells(LastRow, 1), .Cells(LastRow, LastCol))
          If x.MergeCells Then
            With x.MergeArea
              LastRow = Max(LastRow, .Rows(.Rows.Count).Row)
            End With
          End If
        Next
        ' Determine if any merged cells are beyond the last column
        For Each x In Range(.Cells(1, LastCol), .Cells(LastRow, LastCol))
          If x.MergeCells Then
            With x.MergeArea
              LastCol = Max(LastCol, .Columns(.Columns.Count).Column)
            End With
          End If
        Next
        ' Determine if any shapes are beyond the last row and last column
        ShpLastCol = LastCol
        ShpLastRow = LastRow
        For Each Shp In .Shapes
          If Shp.Type <> msoComment Then  ' ZVI:2010-06-16
            ShpLastCol = Max(ShpLastCol, Shp.BottomRightCell.Column)
            ShpLastRow = Max(ShpLastRow, Shp.BottomRightCell.Row)
          End If
        Next
        ' Clear cells beyond the last column
        If LastCol < .Columns.Count Then
          With .Range(.Columns(LastCol + 1), .Columns(.Columns.Count))
            .Clear
            If LastCol >= ShpLastCol Then
              ' Set StandardWidth to columns which are beyond the last col
              .EntireColumn.ColumnWidth = IIf(Ws.StandardWidth, Ws.StandardWidth, 8.43) 'Ws.StandardWidth
            End If
          End With
          If ShpLastCol < .Columns.Count Then
            ' Set StandardWidth to columns which are beyond the Shapes
            With .Range(.Columns(ShpLastCol + 1), .Columns(.Columns.Count))
              .EntireColumn.ColumnWidth = IIf(.StandardWidth, .StandardWidth, 8.43) 'Ws.StandardWidth
            End With
          End If
        End If
        ' Clear cells beyond the last row
        If LastRow < .Rows.Count Then
          With .Range(.Rows(LastRow + 1), .Rows(.Rows.Count))
            .Clear
            If LastRow >= ShpLastRow Then
              ' Set StandardWidth to rows which are beyond the last row
              .EntireRow.RowHeight = IIf(Ws.StandardHeight, Ws.StandardHeight, 12.75)
            End If
          End With
          If ShpLastRow < .Rows.Count Then
            ' Set StandardHeight to rows which are beyond the Shapes
            With .Range(.Rows(ShpLastRow + 1), .Rows(.Rows.Count))
              .EntireRow.RowHeight = IIf(.StandardHeight, .StandardHeight, 12.75)
            End With
          End If
        End If
        ' Reset last cell position of the sheet
        With .UsedRange: End With
        ' Protect the sheet if it was unprotected
        If Prot Then .Protect
      End If
      ' Apply setting to worksheet's charts: ChartArea.AutoScaleFont = False
      If DoCharts Then
        For I = 1 To .ChartObjects.Count
          Application.StatusBar = "MrExcelDiet: processing of chart " & .ChartObjects(I).Name
          .ChartObjects(I).Chart.ChartArea.AutoScaleFont = False
          ChartsCleared = ChartsCleared + 1
        Next
      End If
    End With
  Next
  ' Apply setting to workbook's charts: ChartArea.AutoScaleFont = False
  If DoCharts Then
    With Wb
      For I = 1 To .Charts.Count
        ' Clear an error flag
        Err.Clear
        ' Inform on processing status
        Application.StatusBar = "MrExcelDiet: processing of chart " & .Charts(I).Name
        ' Check chart sheet protection
        Prot = .Charts(I).ProtectContents
        ' Try to unprotect chart sheet without password
        If Prot Then .Charts(I).Unprotect ""
        If (Err <> 0 Or .Charts(I).ProtectContents) And ProtWarning Then
          SheetsProtSkipped = SheetsProtSkipped + 1
          x = MsgBox(Ws.Name & " is protected and will be skipped" & vbLf & vbLf & _
                     "Skip warning on protected sheets?" & vbLf & vbLf & _
                     "Yes" & vbTab & "- Skip warning, clear sheets silently" & vbLf & _
                     "No" & vbTab & "- Warning on each protected sheets" & vbLf & _
                     "Cancel" & vbTab & "- Stop clearing & Exit", _
                     vbExclamation + vbYesNoCancel, _
                     Title)
          ProtWarning = (x = vbNo)
          If x = vbCancel Then GoTo exit_
        Else
          ' Set AutoScaleFont = False for chart sheet
          .Charts(I).ChartArea.AutoScaleFont = False
          SheetsCleared = SheetsCleared + 1
          ChartsCleared = ChartsCleared + 1
          ' Protect the chart sheet if it was unprotected
          If Prot Then .Charts(I).Protect
        End If
      Next
    End With
  End If
exit_:
  ' Calculate the new file size
  Wb.SaveCopyAs FileNameTmp
  BytesInFileNew = CreateObject("Scripting.FileSystemObject").GetFile(FileNameTmp).Size
  Kill FileNameTmp
  ' Freeze off
  With Application
    .Calculation = ac
    .ScreenUpdating = True
    .EnableEvents = True
  End With
  ' Report on results
  Application.StatusBar = False
  x = MsgBox("Statistics of excess formatting clearing" & vbLf & vbLf & _
             "Workbook:" & vbTab & ActiveWorkbook.Name & vbLf & _
             "Sheets total:" & vbTab2 & SheetsTotal & vbLf & _
             "Sheets cleared:" & vbTab2 & SheetsCleared & vbLf & _
             "Protected sheets skipped: " & vbTab & SheetsProtSkipped & vbLf & _
             "Other sheets skipped:" & vbTab & SheetsTotal - SheetsCleared - SheetsProtSkipped & vbLf & _
             "Charts cleared:" & vbTab2 & ChartsCleared & vbLf & _
             "File size old:" & vbTab & Format(BytesInFileOld, "# ### ##0") & " Bytes" & vbLf & _
             "File size new:" & vbTab & Format(BytesInFileNew, "# ### ##0") & " Bytes" & vbLf & _
             vbLf & _
             "Save the cleared workbook to keep the changes?" & vbLf & _
             "Yes" & vbTab & "- Save & Exit" & vbLf & _
             "No" & vbTab & "- Exit without saving, cleared", _
             vbInformation + vbYesNo + IIf(BytesInFileNew < BytesInFileOld, vbDefaultButton1, vbDefaultButton2), _
             Title)
  If x = vbYes Then Wb.Save
End Sub


' ZVI:2009-02-02 Get last cell within values/formulas/comments of sheet Sh
' Auto-filtered & hidden rows/columns are also calculated without ShowAllData
' ActiveSheet is used if optional Sh is missing
' If VisibleOnly=True then only visible cells are searched
Function GetLastCell(Optional Sh As Worksheet, Optional VisibleOnly As Boolean) As Range
  Dim SpecCells(), rng As Range, R&, c&, x, a
  SpecCells = Array(xlCellTypeConstants, xlCellTypeFormulas, xlCellTypeComments)
  On Error Resume Next
  If Sh Is Nothing Then Set Sh = ActiveSheet
  Set rng = Sh.UsedRange
  If VisibleOnly Then Set rng = rng.SpecialCells(xlCellTypeVisible)
  For Each x In SpecCells
    For Each a In rng.SpecialCells(x).Areas
      With a.Cells(a.Rows.Count, a.Columns.Count)
        c = Max(c, .Column)
        R = Max(R, .Row)
      End With
    Next
  Next
  If R * c <> 0 Then Set GetLastCell = Sh.Cells(R, c)
End Function


' Aux function: max value of arguments
Private Function Max(ParamArray Values())
  Dim x
  For Each x In Values
    If x > Max Then Max = x
  Next
End Function

Mark,
This worked EXTREMELY well! Thank you! I see why it was a good idea to run it on a copy, but in my case the formatting issue is easy to work around.
Now I need to take my time and go through this routine and figure out what it actually does.

 

[PoggiPJ]

SOLVED: Slow Performance after Saving file in "Excel 97-2003" format

While performance did improve, the real slow problem persisted even after MrExcelDiet was installed. The solution turned out to be that opening the file in 2010 enabled the MultiThreadedCalculation setting. When the file is returned to a 2003 user, I'm guessing that Excel 2003 is not capable of handling it. Adding the following code at the Workbook Open has completely solved the problem.

Dim ans As Variant
On Error Resume Next
    Application.MultiThreadedCalculation.Enabled = False
On Error GoTo 0