View Full Version : File size reduction
Veeru
08-09-2017, 11:57 AM
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
08-09-2017, 12:01 PM
Please use Code tags or # button
mdmackillop
08-09-2017, 12:09 PM
What value is returned by LastCol in that line?
Veeru
08-09-2017, 12:48 PM
Nothing...it gives me debug error and error message says "Application defined error"
Paul_Hossler
08-09-2017, 12:55 PM
How many worksheets / charts / etc.?
How many rows and columns on the largest worksheet?
mdmackillop
08-09-2017, 01:01 PM
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
08-10-2017, 09:42 AM
I have around 50 worksheets in this workbook and largest has 95000 rows
and Last col value says 16384
mdmackillop
08-10-2017, 10:25 AM
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
08-10-2017, 12:09 PM
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
08-10-2017, 01:33 PM
They should go in the position indicated, after the Set ColFormula line
Veeru
08-11-2017, 10:56 AM
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....
Hey, Paul,
Where's your famous "Style Deletion" technique?
Paul_Hossler
08-11-2017, 12:04 PM
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
Will it run on Excel 2002? :D
Veeru
08-11-2017, 01:20 PM
thanks guys for taking pain and discussing this, please let me know once we have any update on the same....thanks
How much Cell and Font formatting is in the Book? Styles, Custom, and Conditional.
Paul_Hossler
08-11-2017, 02:49 PM
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
08-14-2017, 06:54 AM
my file contains lots of graphs and charts....so zipping the file is the only solution we have??
mdmackillop
08-14-2017, 07:28 AM
You file is already "zipped" by Excel. Make a copy and change the extension to .ZIP to see the contents as above.
Veeru
08-14-2017, 08:57 AM
i am sorry but tht not seems to be right solution...my file got corrupt after changing extension to .zip from .xlsm
Did you unzip the Renamed Copy of the file?
Veeru
08-14-2017, 01:17 PM
How to unzip it?
I like 7-Zip, but I have used others in this list: http://www.techshout.com/features/2012/05/best-unzip-programs/
Paul_Hossler
08-14-2017, 02:34 PM
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
08-14-2017, 02:46 PM
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
08-14-2017, 02:59 PM
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
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
08-15-2017, 06:14 AM
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
08-15-2017, 09:16 AM
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
08-15-2017, 09:54 AM
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
08-15-2017, 10:47 AM
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
08-15-2017, 11:38 AM
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
08-15-2017, 11:54 AM
It is actually col. AH and I have deleted from AI to far right & save it but file size remain the same....
Veeru
08-15-2017, 11:56 AM
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
08-15-2017, 12:49 PM
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
08-15-2017, 05:05 PM
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
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
08-17-2017, 06:19 AM
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
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
08-17-2017, 07:54 AM
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
08-17-2017, 08:30 AM
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
08-17-2017, 09:58 AM
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...
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
08-17-2017, 11:46 AM
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....
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.