Excel VBA Macro: Check Size of Each Worksheet (in Current Workbook)

Excel VBA Macro: Check Size of Each Worksheet (in Current Workbook). Find out which parts of an Excel workbook are the biggest in size.
💥Subscribe: / @greggowaffles
Code:
Sub worksheet_sizes()
Dim i As Integer
Dim row_count As Integer
Dim tab_check As Integer
Dim tab_count As Integer
Dim tab_name As String
Dim sh As String
Dim temp_book As String
Dim ws As Worksheet
Dim new_tab As Worksheet
Application.ScreenUpdating = False
tab_check = 0
tab_count = Sheets.Count
tab_name = "Worksheet Sizes"
For i = 1 To tab_count
If Sheets(i).Name = tab_name Then
tab_check = 1
End If
Next i
If tab_check = 0 Then
ThisWorkbook.Worksheets.Add(before:=Application.Worksheets(1)).Name = tab_name
End If
temp_book = ThisWorkbook.Path & "\Temp.xls"
Set new_tab = Application.Worksheets(tab_name)
With new_tab
.Cells.Clear
.Cells(1, 1) = "Name"
.Cells(1, 2) = "Size (KB)"
End With
For Each ws In ActiveWorkbook.Worksheets
If ws.Name ＜＞ tab_name Then
ws.Copy
ActiveWorkbook.SaveAs temp_book
ActiveWorkbook.Close savechanges:=False
new_tab.Activate
row_count = WorksheetFunction.CountA(Range("A1", Range("A1").End(xlDown)))
With new_tab
.Cells(row_count + 1, 1) = ws.Name
.Cells(row_count + 1, 2) = FileLen(temp_book) / 1000
End With
Kill temp_book
End If
Next
Application.ScreenUpdating = True
End Sub
#excelvba #excelmacro

[@deepk82]

Great share

[@Jojosmith342]

thank you very much Greg for the code & clear video. Always thumb up from the beginning class 👍

[@ahmed007Jaber]

Thank you Greg Just wondering if you checked the sum of all sheets and if it equaled the original file I will definitely check it out in the morning. Was trying to do this today

[@alializadeh8195]

Thanx

[@greggowaffles]

No prob! Thanks for watching!!

[@jonnathanjon1]

Hi I was trying to show this in a pop up message box using msgbx syntax instead of showing in a new sheet. Can you help?

[@greggowaffles]

hi Johnathan! yup! hope this helps! Sub worksheet_sizes_w_msgbox() Dim temp_book As String Dim ws As Worksheet Dim message As String Application.ScreenUpdating = False temp_book = ThisWorkbook.Path & "\Temp.xls" For Each ws In ActiveWorkbook.Worksheets ws.Copy ActiveWorkbook.SaveAs temp_book ActiveWorkbook.Close savechanges:=False message = message & ws.Name & ": " & _ FileLen(temp_book) / 1000 & " KB" & vbNewLine Kill temp_book Next Application.ScreenUpdating = True MsgBox message End Sub

[@greggowaffles]

made a video too! kzbin.info/www/bejne/hmqvZJyhj9B5q6M