Ascertaining Tab Size

S

stroffso

Board Regular
Joined
Jul 12, 2016
Messages
160
Office Version
  1. 365
Platform
  1. Windows
Was wondering if you geniuses could help me, I have a 41MB file that doesnt have any array formulas or huge tabs in it (although there are a lot of tabs), I have done the basic deleting contents of unused cells but the file size doesnt change. Is there any way to check via code or other on the breakdown of size by tab? That way I could identify the ones that are bigger and then adjust accordingly otherwise this is just picking tabs at random and hoping for the best

thanks in advance
 

Excel Facts

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying
Sort by date Sort by votes
Try the code below written by @ZVI

VBA Code: 
Sub SheetsSize()
  
  Dim a(), Bytes As Double, i As Long, FileNameTmp As String
  Dim Sh, Wb As Workbook
  
  Set Wb = ActiveWorkbook
  ReDim a(0 To Wb.Sheets.Count, 1 To 2)
  
  ' Turn off screen updating
  Application.ScreenUpdating = False
  On Error GoTo exit_
  
  ' Put names into a(,1) and sizes into a(,2)
  With CreateObject("Scripting.FileSystemObject")
    ' Build the temporary file nane
    FileNameTmp = .GetSpecialFolder(2) & "\" & Wb.Name & ".TMP"
    ' Save workbook
    Wb.SaveCopyAs FileNameTmp
    ' Put workbook's name and size into a(0,)
    a(0, 1) = Wb.Name
    a(0, 2) = .GetFile(FileNameTmp).Size
    ' Put each sheet name and its size into a(i,)
    For i = 1 To Wb.Sheets.Count
      Wb.Sheets(i).Copy
      ActiveWorkbook.SaveCopyAs FileNameTmp
      a(i, 1) = Wb.Sheets(i).Name
      a(i, 2) = .GetFile(FileNameTmp).Size
      Bytes = Bytes + a(i, 2)
      ActiveWorkbook.Close False
    Next
    Kill FileNameTmp
  End With
  
   ' Show workbook's name & size
  Debug.Print a(0, 1), Format(a(0, 2), "# ### ### ##0") & " Bytes"
  
  ' Show workbook object's  size
  Debug.Print "Wb Object", Format(a(0, 2) - Bytes, "# ### ### ##0") & " Bytes"
  
  ' Show each sheet name and its size
  For i = 1 To UBound(a)
    Debug.Print a(i, 1), Format(a(i, 2), "# ### ### ##0") & " Bytes"
  Next
exit_:
  
  ' Restore screen updating and show error reason if happened
  Application.ScreenUpdating = True
  
  ' Show the reason of error if happened
  If Err Then MsgBox Err.Description, vbCritical, "Error"
End Sub
 
Upvote 0
Thanks but I kept getting the same error on multiple sheets "we couldnt copy this sheet"
 
Upvote 0
What version of Excel are you using?

I suggest that you update your Account details (or click your user name at the top right of the forum) so helpers always know what Excel version(s) & platform(s) you are using as the best solution often varies by version. (Don’t forget to scroll down & ‘Save’)

If you have access to Excel Online, it might be enlightening to load your spreadsheet to Excel Online and run the Check Performance feature.
 
Upvote 0
stroffso said:
Thanks but I kept getting the same error on multiple sheets "we couldnt copy this sheet"
Click to expand...
The code wasn't designed to cure any errors, it was to ascertain the sheet sizes as requested
 
Upvote 0
Alex Blakenburg said:
What version of Excel are you using?

I suggest that you update your Account details (or click your user name at the top right of the forum) so helpers always know what Excel version(s) & platform(s) you are using as the best solution often varies by version. (Don’t forget to scroll down & ‘Save’)

If you have access to Excel Online, it might be enlightening to load your spreadsheet to Excel Online and run the Check Performance feature.
Click to expand...
Thank you for that advice I have done so, running office 365
 
Upvote 0
MARK858 said:
The code wasn't designed to cure any errors, it was to ascertain the sheet sizes as requested
Click to expand...
I understand this and wasnt looking for it to cure any errors I more meant as soon as I run the code that error message appears as if there is something wrong with the code, I tried it for about 15 tabs and the same thing happened every time. Not to worry thanks all for your help
 
Upvote 0
If you just want a summary of the used ranges of all your sheets, give this a try.
Note: It creates a sheet called Worksheet Summary.
(You will need to manually delete that sheet if you want to run it again)

VBA Code: 
Sub WorksheetSummary()
    
    Dim Summary As Worksheet, ws As Worksheet
    Dim RowNoStart As Long, RowNo As Long
    Dim strSheetName As String, strSheetAddress As String, strSheetName_Addr As String
    Dim bVisible As Boolean
    Dim i As Long

    Worksheets.Add Before:=Sheets(1)
    Set Summary = ActiveSheet
    Summary.Name = "WorkSheet Summary"
    
    RowNoStart = 1
    With Summary.Cells(RowNoStart, 1)
        .Value = "Summary"
        .Style = "Heading 1"
    End With
    
    RowNo = RowNoStart + 2
    
    Summary.Cells(RowNo, 1) = "Name"
    Summary.Cells(RowNo, 2) = "Used Range"
    Summary.Cells(RowNo, 3) = "Visible"
  
    With Summary.Rows(RowNo)
        .Font.Bold = True
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
    End With
       
    For i = 2 To Worksheets.Count
            RowNo = RowNo + 1
            Set ws = Worksheets(i)
            Summary.Cells(RowNo, 1) = ws.Name
            
            ' Add HyperLink back to sheet to Sheet Name
            strSheetName = ws.Name
            strSheetAddress = "A1"
            strSheetName_Addr = "'" & strSheetName & "'!" & strSheetAddress

            ActiveSheet.Hyperlinks.Add Anchor:=Summary.Cells(RowNo, 1), Address:="", SubAddress:= _
                strSheetName_Addr, TextToDisplay:=strSheetName
            
            ' Continue adding other details
            Summary.Cells(RowNo, 2) = ws.UsedRange.Address
            bVisible = ws.Visible
            Summary.Cells(RowNo, 3) = bVisible

    Next

    Summary.Columns(1).Resize(, 3).AutoFit
    
End Sub
 
Upvote 1
Alex Blakenburg said:
If you just want a summary of the used ranges of all your sheets, give this a try.
Note: It creates a sheet called Worksheet Summary.
(You will need to manually delete that sheet if you want to run it again)

VBA Code: 
Sub WorksheetSummary()
   
    Dim Summary As Worksheet, ws As Worksheet
    Dim RowNoStart As Long, RowNo As Long
    Dim strSheetName As String, strSheetAddress As String, strSheetName_Addr As String
    Dim bVisible As Boolean
    Dim i As Long

    Worksheets.Add Before:=Sheets(1)
    Set Summary = ActiveSheet
    Summary.Name = "WorkSheet Summary"
   
    RowNoStart = 1
    With Summary.Cells(RowNoStart, 1)
        .Value = "Summary"
        .Style = "Heading 1"
    End With
   
    RowNo = RowNoStart + 2
   
    Summary.Cells(RowNo, 1) = "Name"
    Summary.Cells(RowNo, 2) = "Used Range"
    Summary.Cells(RowNo, 3) = "Visible"
 
    With Summary.Rows(RowNo)
        .Font.Bold = True
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
    End With
      
    For i = 2 To Worksheets.Count
            RowNo = RowNo + 1
            Set ws = Worksheets(i)
            Summary.Cells(RowNo, 1) = ws.Name
           
            ' Add HyperLink back to sheet to Sheet Name
            strSheetName = ws.Name
            strSheetAddress = "A1"
            strSheetName_Addr = "'" & strSheetName & "'!" & strSheetAddress

            ActiveSheet.Hyperlinks.Add Anchor:=Summary.Cells(RowNo, 1), Address:="", SubAddress:= _
                strSheetName_Addr, TextToDisplay:=strSheetName
           
            ' Continue adding other details
            Summary.Cells(RowNo, 2) = ws.UsedRange.Address
            bVisible = ws.Visible
            Summary.Cells(RowNo, 3) = bVisible

    Next

    Summary.Columns(1).Resize(, 3).AutoFit
   
End Sub
Click to expand...
This is absolutely fantastic thank you so much
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Question
Excel pivot table query - retaining filters on pivot in absence of data
2
Replies
10
Views
1K
Alex Blakenburg
A
S
  • Question
Excel Xlookup + Filter Combination
Replies
2
Views
2K
RudRud
R
A
  • Solved
Calendar form cancel button passing data to worksheet
Replies
7
Views
439
AndyEd
A
D
  • Question
VBA - Split Source file-Find oldest date in column. Copy all rows with date to new sheet, Repeat on next oldest date. Also, remove some unwanted data.
Replies
0
Views
922
DK643
D
A
  • Solved
Calendar issue
Replies
1
Views
1K
AndyEd
A

Forum statistics

Threads
1,215,335
Messages
6,124,326
Members
449,155
Latest member
ravioli44

Share this page

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