File size reduction

[Veeru]

Hi,

I am working on one file and now due to number of macros and data, file size reaches at 60mb and now I find difficultly just to open it.
I want to reduce the size of my file and find below code , which I found in this forum only


Sub ExcelDiet()

Dim j As Long
Dim k As Long
Dim LastRow As Long
Dim LastCol As Long
Dim ColFormula As Range
Dim RowFormula As Range
Dim ColValue As Range
Dim RowValue As Range
Dim Shp As Shape
Dim ws As Worksheet

Application.ScreenUpdating = False
Application.DisplayAlerts = False

On Error Resume Next

For Each ws In Worksheets
With ws
'Find the last used cell with a formula and value
'Search by Columns and Rows
On Error Resume Next
Set ColFormula = .Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious)
Set ColValue = .Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious)
Set RowFormula = .Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
Set RowValue = .Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
On Error GoTo 0

'Determine the last column
If ColFormula Is Nothing Then
LastCol = 0
Else
LastCol = ColFormula.Column
End If
If Not ColValue Is Nothing Then
LastCol = Application.WorksheetFunction.Max(LastCol, ColValue.Column)
End If

'Determine the last row
If RowFormula Is Nothing Then
LastRow = 0
Else
LastRow = RowFormula.Row
End If
If Not RowValue Is Nothing Then
LastRow = Application.WorksheetFunction.Max(LastRow, RowValue.Row)
End If

'Determine if any shapes are beyond the last row and last column
For Each Shp In .Shapes
j = 0
k = 0
On Error Resume Next
j = Shp.TopLeftCell.Row
k = Shp.TopLeftCell.Column
On Error GoTo 0
If j > 0 And k > 0 Then
Do Until .Cells(j, k).Top > Shp.Top + Shp.Height
j = j + 1
Loop
If j > LastRow Then
LastRow = j
End If
Do Until .Cells(j, k).Left > Shp.Left + Shp.Width
k = k + 1
Loop
If k > LastCol Then
LastCol = k
End If
End If
Next

.Range(.Cells(1, LastCol + 1), .Cells(.Rows.Count, .Columns.Count)).EntireColumn.Delete
.Range("A" & LastRow + 1 & ":A" & .Rows.Count).EntireRow.Delete
End With
Next

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

But while running it is giving my error "Application defined error" for

.Range(.Cells(1, LastCol + 1), .Cells(.Rows.Count, .Columns.Count)).EntireColumn.Delete

Please suggest what changes needs to be made here??
Thanks

[mdmackillop]

Please use Code tags or # button

[mdmackillop]

What value is returned by LastCol in that line?

[Veeru]

Nothing...it gives me debug error and error message says "Application defined error"

[Paul_Hossler]

How many worksheets / charts / etc.?

How many rows and columns on the largest worksheet?

[mdmackillop]

If you run the code to get the error, use the debug to go to that line. Put the cursor over LastCol. You should see a value.

[Veeru]

I have around 50 worksheets in this workbook and largest has 95000 rows
and Last col value says 16384

[mdmackillop]

Last col value says 16384
This means that the code is finding something in the last column of the worksheet so LastCol + 1 causes an error. As it finds data, it should not in any case delete that or preceding columns.

Insert these extra 4 lines to go to the problem cell

Set ColFormula = .Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious)

If ColFormula.Column = 16384 Then
Application.Goto ColFormula
Exit Sub
End If

[Veeru]

I have inserted these extra 4 lines after
Application.ScreenUpdating = True
Application.DisplayAlerts = True

but now it is giving error unqualified reference on ".Cells" in this line

Set ColFormula = .Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlFormulas, _

[mdmackillop]

They should go in the position indicated, after the Set ColFormula line

[Veeru]

Yes it is working now...but after running this code and saving this file ...there is no difference in file size...it still counts at 60Mb....

[SamT]

Hey, Paul,

Where's your famous "Style Deletion" technique?

[Paul_Hossler]

Hey, Paul,

Where's your famous "Style Deletion" technique?

I was going to suggest that, but not knowing what the real problem might be, I decided it might be better not to


However, I have started a new macro to extract and display WB and WS parameters to at least identify possible issues


Since you volunteered, you can be a beta tester

[SamT]

Will it run on Excel 2002? :D

[Veeru]

thanks guys for taking pain and discussing this, please let me know once we have any update on the same....thanks

[SamT]

How much Cell and Font formatting is in the Book? Styles, Custom, and Conditional.

[Paul_Hossler]

One way to narrow it down is to rename the excel file as a .zip and open it with any unzipper

Something in the file is huge and the 3 most likely areas to see are

20064
20065
20066

I think the WB got corrupted

[Veeru]

my file contains lots of graphs and charts....so zipping the file is the only solution we have??

[mdmackillop]

You file is already "zipped" by Excel. Make a copy and change the extension to .ZIP to see the contents as above.

[Veeru]

i am sorry but tht not seems to be right solution...my file got corrupt after changing extension to .zip from .xlsm

[SamT]

Did you unzip the Renamed Copy of the file?

[Veeru]

How to unzip it?

[SamT]

I like 7-Zip, but I have used others in this list: http://www.techshout.com/features/2012/05/best-unzip-programs/

[Paul_Hossler]

How to unzip it?


An XLSM file is actually a ZIP file

By renaming the extension to .ZIP you can use an unzip program to view the contents like in my screen shots-- there is no need to actually pull the pieces out

So MyFile.xlsm becomes MyFile.xlsm.zip to allow a unzip program to open it

By looking to see which are the largest components you can have a possible path to investigate

For example,

If Styles.xml is 2MB, there are too many styles that have build up (typically by copy/pasting from other workbooks)

If Sheet5.xlm is 45MB, there is probably corruption, or maybe formatting and/or data that is in the high number rows or columns

After that, just rename MyFile.xlsm.zip back to MyFile.xlsm

[mdmackillop]

If Sheet5.xlm is 45MB, there is probably corruption, or maybe formatting and/or data that is in the high number rows or columns
In post #7, OP has confirmed data in Column 16384

[Paul_Hossler]

In post #7, OP has confirmed data in Column 16384

Yea, ... your macro's LastCol was = 16384, BUT the real question is if that is meaningful data, or an errant keystroke in the far right?


@Veeru -- Select and then delete all columns to the right after the last meaningful column of real data

It seems hard to believe that a 950,000 x 16384 worksheet is correct

[snb]

An XLSM file is actually a ZIP file

By renaming the extension to .ZIP you can use an unzip program to view the contents like in my screen shots-- there is no need to actually pull the pieces out

You can start a zip program and open the excelfile in it. No need to rename any file.

Or: select the Excel file, rightclick, open with Izarc or any other zip-program.

[Paul_Hossler]

You can start a zip program and open the excelfile in it. No need to rename any file.

Or: select the Excel file, rightclick, open with Izarc or any other zip-program.

All true, but sometimes it's better to be very straight-forward, even if it's a bit less efficient (just my HO)

[Veeru]

renaming the file to .zip and unzip didn't work....it every time corrupt my file...I am not sure if I got another point...I have lots of lots of sheets in there...so which sheet to go and delete columns as you mentioned in # 26...

[mdmackillop]

Try this to get some basic information

Sub Data()
Dim arr()
Dim sh As Worksheet




ReDim arr(Worksheets.Count, 5)
On Error Resume Next
arr(0, 0) = "Name"
arr(0, 1) = "Last Col"
arr(0, 2) = "Last Row"
arr(0, 3) = "Usedrange cells"
arr(0, 4) = "Constants"
arr(0, 5) = "Formulas"
For Each sh In Worksheets


With sh
i = i + 1
LastCol = .Cells.Find("*", .Cells(1, 1), , , xlByColumns, xlPrevious).Column
LastRow = .Cells.Find("*", .Cells(1, 1), , , xlByRows, xlPrevious).Row
ucells = .UsedRange.Cells.Count
ccells = 0
ccells = .UsedRange.SpecialCells(2).Count
fcells = 0
fcells = .UsedRange.SpecialCells(-4213).Count


arr(i, 0) = .Name
arr(i, 1) = LastCol
arr(i, 2) = LastRow
arr(i, 3) = ucells
arr(i, 4) = ccells
arr(i, 5) = fcells


End With
Next sh
Sheets.Add
Cells(1, 1).Resize(Worksheets.Count, 6) = arr
Rows(1).Font.Bold = True
Cells(1, 1).Resize(Worksheets.Count, 6).Columns.AutoFit


End Sub

[Veeru]

I got 184 sheet in total…from which biggest sheet as below attributes






Name




Last Col



Last Row



Usedrange cells



Constants



Formulas





FY 2016 Concur Raw Data


16384



89604



1468071936



2128723

[Paul_Hossler]

On that worksheet, Excel thinks that 1.46 billion cells are being used, but only 2.1 million cells have data. That's less than 0.15%

20083

What is the LAST column that contains meaningful data?? - I'm guessing it might be around col Y or Z

Select all the columns from the last meaningful one+1 to the far right and delete them to see what happens

[Veeru]

It is actually col. AH and I have deleted from AI to far right & save it but file size remain the same....

[Veeru]

After running the above code again I can see , change below





Name



Last Col



Last Row



Usedrange cells



Constants



Formulas






FY 2016 Concur Raw Data



34



89604



3315348



2128723

[mdmackillop]

This should show the previous column/row to the last. It will also create a temporary workbook for each sheet and return the size of that workbook.

Sub Data()
Dim arr()
Dim sh As Worksheet
Dim tmp As String
Dim wb As Workbook

Application.ScreenUpdating = False
tmp = ActiveWorkbook.Path & "\tmp.xlsm"
wsn = ActiveWorkbook.Name

ReDim arr(Worksheets.Count, 8)
On Error Resume Next
arr(0, 0) = "Name"
arr(0, 1) = "Last Col"
arr(0, 2) = "Prev Col"
arr(0, 3) = "Last Row"
arr(0, 4) = "Prev Row"
arr(0, 5) = "Usedrange cells"
arr(0, 6) = "Constants"
arr(0, 7) = "Formulas"
arr(0, 8) = "Sheet Size"

For Each sh In Worksheets
With sh
i = i + 1
LastCol = .Cells.Find("*", .Cells(1, 1), , , xlByColumns, xlPrevious).Column
LastRow = .Cells.Find("*", .Cells(1, 1), , , xlByRows, xlPrevious).Row
PrevCol = .Cells.Find("*", .Cells(1, Columns.Count), , , xlByColumns, xlPrevious).Column
PrevRow = .Cells.Find("*", .Cells(Rows.Count, 1), , , xlByRows, xlPrevious).Row

ucells = .UsedRange.Cells.Count
ccells = 0
ccells = .UsedRange.SpecialCells(2).Count
fcells = 0
fcells = .UsedRange.SpecialCells(-4213).Count

arr(i, 0) = .Name
arr(i, 1) = LastCol
arr(i, 2) = PrevCol
arr(i, 3) = LastRow
arr(i, 4) = PrevRow
arr(i, 5) = ucells
arr(i, 6) = ccells
arr(i, 7) = fcells
.Copy
Set wb = ActiveWorkbook
If wb.Name <> wsn Then
wb.SaveAs Filename:=tmp, FileFormat:=52
wb.Close False
End If
arr(i, 8) = FileLen(tmp)
Kill tmp
End With
Next sh
Sheets.Add
Cells(1, 1).Resize(Worksheets.Count, 9) = arr
Rows(1).Font.Bold = True
Cells(1, 1).Resize(Worksheets.Count, 9).Columns.AutoFit
Application.ScreenUpdating = True
End Sub

[Paul_Hossler]

You can try this special version

It does not adjust for shapes, but should handle columns out to the max



Option Explicit
Sub ExcelDiet_ver1()

Dim j As Long
Dim k As Long
Dim LastRow As Long
Dim LastCol As Long
Dim ColFormula As Range
Dim RowFormula As Range
Dim ColValue As Range
Dim RowValue As Range
Dim ws As Worksheet

Application.ScreenUpdating = False
Application.DisplayAlerts = False

On Error Resume Next

For Each ws In Worksheets
With ws
'Find the last used cell with a formula and value
'Search by Columns and Rows
On Error Resume Next
Set ColFormula = .Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious)
Set ColValue = .Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious)
Set RowFormula = .Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
Set RowValue = .Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
On Error GoTo 0

'Determine the last column
If ColFormula Is Nothing Then
LastCol = 0
Else
LastCol = ColFormula.Column
End If
If Not ColValue Is Nothing Then
LastCol = Application.WorksheetFunction.Max(LastCol, ColValue.Column)
End If

'Determine the last row
If RowFormula Is Nothing Then
LastRow = 0
Else
LastRow = RowFormula.Row
End If
If Not RowValue Is Nothing Then
LastRow = Application.WorksheetFunction.Max(LastRow, RowValue.Row)
End If

If LastCol = .Columns.Count Then LastCol = LastCol - 1
If LastRow = .Rows.Count Then LastRow = LastRow - 1

.Range(.Cells(1, LastCol + 1), .Cells(.Rows.Count, .Columns.Count)).EntireColumn.Delete
.Range("A" & LastRow + 1 & ":A" & .Rows.Count).EntireRow.Delete
End With
Next

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

[snb]

this might be very helpful:


Sub M_snb()
On Error Resume Next

For Each sh In Sheets
For Each ar In sh.Cells.SpecialCells(4).Areas
ar.Clear
Next

For Each it In sh.Cells.SpecialCells(-4172)
it.FormatConditions.Delete
Next

sh.Shapes.SelectAll
Selection.Delete
Next
End Sub

[Veeru]

Code mentioned in # 35 did list all tabs and their size . so total 88 tabs consist of 21 mb out of 188 tabs

I tried code mentioned in # 36, it did reduce file size by 1 mb only from 60 to 59 mb

But when I tried code # 37…it again increased it to 5 mb and now it reached at 64mb

[SamT]

If any of the Tabs contain only reference data, you can move them to another workbook. If you use Excel to move them, Excel will update any references to them that are in Cell Formulas.
You would still have to manually update any references in your VBA Code.

[Veeru]

Unfortunatly, I dodnt have any reference data. All tabs are interlinked and get updated when I add more data for 2017...then we have data for 2016.. which remain static and at end I am comparing 2016 vs 2017 with various graphs and charts..

[offthelip]

since the 2016 data is static and won't change you could as Sam suggests and move the 2016 data to another workbook, and reference it from your workbook.

[Veeru]

Even after moving 2016 data to new sheet ....my main sheet reduced by 4 mb..which not make any major difference if I see 60 mb sheet in total...

after moving 2017 data as well I assume..it will make a difference of 3 mb...

[SamT]

All 2016 data is static. I would have a 2016 Workbook.

With your BIG Workbook open, Use Excel File Menu to Open a New Workbook. Save that new book in the same folder as the BIG one, but with a name that also says 2016. Save it as a binary file, xlsb.

With both workbooks open, Right Click a 2016 Sheet in the BIG book. Hold down the Ctrl Key and Left Click Each 2016 sheet tab. Then Right Click one of the selected tabs and choose Move + select the New 2016 workbook.

I'm pretty sure...

Excel will update all references in the BIG book to the 2016 Worksheets that are now in the new 2016 book.

Since the 2016 data is static,you won't even have to open it for the BIG book to work.

[Veeru]

Thanks for all guidance...but can we keep the forum open for more few days.. may be some one has more efficient idea to reduce the size of file....