excel file huge

nikko50

Board Regular
Joined
Mar 3, 2004
Messages
155
I have an excel file that is 50mb and I don't know why it is that huge. I did not create this file and was asked to look at it and figure out why it takes 10 minutes to open? There is 3 tabs and very little data. How can it be so huge??
 
Whoops, I only just saw page two of the thread after making my post. I hadn't looked beyond page 1 when posting.

RAM, deleting ALL named ranges is easy. Such as,
Code:
for each nm in names:nm.delete:next nm

However, knowing which ones are old & invalid might require some critical review. Jan Karel Pieterse' "Name Manager" from Rob Bovey's site is an excellent tool.

For me, it was easy to identify unwanted names (there were only three) becasue they referenced the new workbook. Regards, Fazza
 
Upvote 0

Excel Facts

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple
The modified code of Just_Jon for the active workbook excess formatting clearing:
Rich (BB code):

Sub MrExcelDiet()
' ZVI:2009-08-08 Active workbook excess formatting clearing
' Idea & original code of Just_Jon: http://www.mrexcel.com/forum/showthread.php?t=120831
' My first attempt of modification: http://www.mrexcel.com/forum/showthread.php?t=339144
  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 & vbCr & vbCr & _
             "Apply full clearing?" & vbCr & vbCr & _
             "Yes" & vbTab & "- Full mode, including chart's AutoScaleFont=False" & vbCr & _
             "No" & vbTab & "- Medium mode, without charts processing" & vbCr & _
             "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" & vbCr & vbCr & _
                   "Skip warning on protected sheets?" & vbCr & vbCr & _
                   "Yes" & vbTab & "- Skip warning, clear sheets silently" & vbCr & _
                   "No" & vbTab & "- Warning on each protected sheets" & vbCr & _
                   "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
          ShpLastCol = Max(ShpLastCol, Shp.BottomRightCell.Column)
          ShpLastRow = Max(ShpLastRow, Shp.BottomRightCell.Row)
        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 vlast col
              .EntireColumn.ColumnWidth = Ws.StandardWidth
            ElseIf ShpLastCol < .Columns.Count Then
              ' Set StandardWidth to columns which are beyond the Shapes
              With .Range(.Columns(ShpLastCol + 1), .Columns(.Columns.Count))
                .EntireColumn.ColumnWidth = Ws.StandardWidth
              End With
            End If
          End With
        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 = Ws.StandardHeight
            ElseIf ShpLastRow < .Rows.Count Then
              ' Set StandardHeight to rows which are beyond the Shapes
              With .Range(.Rows(ShpLastRow + 1), .Rows(.Rows.Count))
                .EntireRow.RowHeight = Ws.StandardHeight
              End With
            End If
          End With
        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" & vbCr & vbCr & _
                     "Skip warning on protected sheets?" & vbCr & vbCr & _
                     "Yes" & vbTab & "- Skip warning, clear sheets silently" & vbCr & _
                     "No" & vbTab & "- Warning on each protected sheets" & vbCr & _
                     "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
 
Last edited:
Upvote 0
Thank you for feedback, vvSTRIDEvv!
Here is the revised version in which sizes of the comments shapes are ignored.
StandardHeight part is corrected too because zero anomaly of the row's standard height can happen:
Rich (BB code):

Sub MrExcelDiet()
' ZVI:2009-08-08 Active workbook excess formatting clearing
' Idea & original code of Just_Jon: http://www.mrexcel.com/forum/showthread.php?t=120831
' First attempt of modification: http://www.mrexcel.com/forum/showthread.php?t=339144
' 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
Regards,
Vladimir
 
Upvote 0

Forum statistics

Threads
1,224,521
Messages
6,179,289
Members
452,902
Latest member
Knuddeluff

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top