Scribd
Upload
116 views

Shrink Reduce Excel File Size

This document provides a macro to shrink the file size of Excel workbooks by identifying and removing unused rows and columns. It works by: 1. Copying the actual data from each worksheet into a new sheet, finding the furthest row and column with data. 2. Pasting the values, column widths, and pictures from the original sheet to the new sheet. 3. Replacing any sheet references in formulas to point to the new sheets. 4. Deleting the original sheets once cleaned copies are made, to remove empty space and reduce file size.

Uploaded by

juganaru
Copyright
© © All Rights Reserved
Available Formats
Download as DOCX, PDF, TXT or read online on Scribd
116 views

Shrink Reduce Excel File Size

This document provides a macro to shrink the file size of Excel workbooks by identifying and removing unused rows and columns. It works by: 1. Copying the actual data from each worksheet into a new sheet, finding the furthest row and column with data. 2. Pasting the values, column widths, and pictures from the original sheet to the new sheet. 3. Replacing any sheet references in formulas to point to the new sheets. 4. Deleting the original sheets once cleaned copies are made, to remove empty space and reduce file size.

Uploaded by

juganaru
Copyright
© © All Rights Reserved
Available Formats
Download as DOCX, PDF, TXT or read online on Scribd
You are on page 1/ 2

SHRINK REDUCE EXCEL FILE SIZE

QUERIES AND SOLUTIONS TUTORIALS VBA MACRO


When you received the file, the size was in Kbs or not more than 5-6 Mbs but when you checked it,
did very little or negligible things, and saved your workbook, you found out the file size has been
bloated to 3 to 100 times. It is possible, it happens in Excel. So don't worry too much.

Source of issue: First understand the difference between 'Excel Default Last Cell' and 'Actual Last
Cell'. When you do 'Ctrl+End' to find last cell, you'll reach to 'Excel Default Last Cell' which may be
the 'Actual Last Cell' or beyond the 'Actual Last Cell'. The more beyond 'Excel Default Last Cell'
would be from 'Actual Last Cell', the more unnecessary size of excel workbook would it be having.

Solution: Delete all rows and columns beyond the 'Actual Last Cell' in every worksheet. If there are
too many worksheets and large sets of data, you can use the VBA macro mentioned below.

Option Explicit
Sub SHRINK_EXCEL_FILE_SIZE()

Dim WSheet As Worksheet


Dim CSheet As String 'New Worksheet
Dim OSheet As String 'Old WorkSheet
Dim Col As Long
Dim ECol As Long 'Last Column
Dim lRow As Long
Dim BRow As Long 'Last Row
Dim Pic As Object

For Each WSheet In Worksheets


WSheet.Activate
'Put the sheets in a variable to make it easy to go back and forth
CSheet = WSheet.Name
'Rename the sheet to its name with _Delete at the end
OSheet = CSheet & "_Delete"
WSheet.Name = OSheet
'Add a new sheet and call it the original sheets name
Sheets.Add
ActiveSheet.Name = CSheet
Sheets(OSheet).Activate
'Find the bottom cell of data on each column and find the further row
For Col = 1 To Columns.Count 'Find the actual last bottom row
If Cells(Rows.Count, Col).End(xlUp).Row > BRow Then
BRow = Cells(Rows.Count, Col).End(xlUp).Row
End If
Next

'Find the end cell of data on each row that has data and find the furthest one
For lRow = 1 To BRow 'Find the actual last right column
If Cells(lRow, Columns.Count).End(xlToLeft).Column > ECol Then
ECol = Cells(lRow, Columns.Count).End(xlToLeft).Column
End If
Next

'Copy the REAL set of data


Range(Cells(1, 1), Cells(BRow, ECol)).Copy
Sheets(CSheet).Activate
'Paste Every Thing
Range("A1").PasteSpecial xlPasteAll
'Paste Column Widths
Range("A1").PasteSpecial xlPasteColumnWidths

Sheets(OSheet).Activate
For Each Pic In ActiveSheet.Pictures
Pic.Copy
Sheets(CSheet).Paste
Sheets(CSheet).Pictures(Pic.Index).Top = Pic.Top
Sheets(CSheet).Pictures(Pic.Index).Left = Pic.Left
Next Pic
Sheets(CSheet).Activate

'Reset the variable for the next sheet


BRow = 0
ECol = 0
Next WSheet

' Since, Excel will automatically replace the sheet references for you on your formulas,
' the below part puts them back.
' This is done with a simple replace, replacing _Delete with nothing
For Each WSheet In Worksheets
WSheet.Activate
Cells.Replace "_Delete", ""
Next WSheet

'Roll through the sheets and delete the original fat sheets
For Each WSheet In Worksheets
If Not Len(Replace(WSheet.Name, "_Delete", "")) = Len(WSheet.Name) Then
Application.DisplayAlerts = False
WSheet.Delete
Application.DisplayAlerts = True
End If
Next
End Sub

You might also like