Results 1 to 2 of 2
  1. #1
    BAT Guest

    Unhappy Excel sheet grew in size with just a little edit

    Hi guys,

    I had an excel file that I recieved from a client. It has some test data for his machine output.The file shouldn;t exceed a certain size limit as it is sent over the network by the client. I just openend and may be changed a little text and the size has grown two times. Please help, how do i bring it back to its original size

  2. #2
    MrTee Guest

    Default

    very common occurance in Excel .....
    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.

    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

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •