# why my excel workbook is 10+mb size with no data in it.



## Prashant1211 (Nov 19, 2022)

Hello Excel experts, 

I have a workbook where i have no data in it but it still it has size 10+ MB. initially everything was okay but the size drastically increased after i opened this file with below macro and transferred some text in it. . Any help in this matter is greatly appreciated.  Thanks 

below is the code -

Application.ScreenUpdating = False

ThisWorkbook.Worksheets("Summary").Activate

ThisWorkbook.Worksheets("Summary").Range("p2").Value = ThisWorkbook.Worksheets("Main Sheet").Range("B6").Value
Range("b6").Value = Range("b6").Value

          LastRow = ActiveSheet.UsedRange.Rows.Count


    FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files (*.xls*),*xls*")
    If FileToOpen = False Then Exit Sub
        Set OpenBook = Application.Workbooks.Open(FileToOpen)

   Application.DisplayAlerts = False
OpenBook.Worksheets("Colidata").Delete

Sheets.Add(After:=Sheets("Sheet1")).Name = "Colidata"

ThisWorkbook.Worksheets("Summary").Range("A5:E5" & LastRow).Copy Destination:=OpenBook.Worksheets("Colidata").Range("A1")
ThisWorkbook.Worksheets("Summary").Range("p2").Copy Destination:=OpenBook.Worksheets("Colidata").Range("P2")

OpenBook.Worksheets("Sheet1").Activate

          Application.DisplayAlerts = True

        OpenBook.Save
          OpenBook.Close False


----------



## rollis13 (Nov 19, 2022)

Tested your macro, it doesn't seem to be the cause of your issue. I would change `.Range("A5:E5" & LastRow).Copy` to `.Range("A5:E" & LastRow).Copy`. As it is if your last row is, say, 1238 then your macro would copy range A5:E51238 that is much more than needed. But this will not change the size of your file, at most it may increase that of the target file.
With someother macro you are probably filling your cells out of the needed ranges with formulas and/or background. Try getting rid of these and try deleting (not clearing) all the empty rows and columns outside of your needed range of every sheet. Then save the file and check the new size.


----------



## Logit (Nov 19, 2022)

Create a COPY of your workbook. Paste the following macro into a routine module in that COPY version :


```
Sub LipoSuction()
'JBeaucaire (8/3/2009)
Dim LR As Long, LC As Long
Dim ws As Worksheet

For Each ws In Worksheets
    LR = ws.Range("A" & ws.Rows.Count).End(xlUp).Row + 1
    LC = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column + 1

    'Clear everything below column A last cell and row 1 last cell
        ws.Range(ws.Cells(1, LC), ws.Cells(ws.Rows.Count, ws.Columns.Count)).Clear
        ws.Range(ws.Cells(LR, 1), ws.Cells(ws.Rows.Count, ws.Columns.Count)).Clear
Next ws

End Sub
```

Run the macro and determine if the workbook size has been reduced. If success, either make the COPY your ORIGINAL workbook
or apply the macro to you original workbook.


----------



## Prashant1211 (Nov 19, 2022)

Logit said:


> Create a COPY of your workbook. Paste the following macro into a routine module in that COPY version :
> 
> 
> ```
> ...


Many thanks .. It worked very well and reduced the file size from 10+Mb to 16kb ..


----------



## Prashant1211 (Nov 19, 2022)

rollis13 said:


> Tested your macro, it doesn't seem to be the cause of your issue. I would change `.Range("A5:E5" & LastRow).Copy` to `.Range("A5:E" & LastRow).Copy`. As it is if your last row is, say, 1238 then your macro would copy range A5:E51238 that is much more than needed. But this will not change the size of your file, at most it may increase that of the target file.
> With someother macro you are probably filling your cells out of the needed ranges with formulas and/or background. Try getting rid of these and try deleting (not clearing) all the empty rows and columns outside of your needed range of every sheet. Then save the file and check the new size.


Thanks for your suggestions but this didnt solved the issue.


----------



## Logit (Nov 19, 2022)

Glad you were able to discard the bulk.


----------



## rollis13 (Nov 20, 2022)

> Thanks for your suggestions but this didnt solved the issue.


Wasn't supposed to fix issues, my second sentence told you to do what Logit's macro did for you, it was up to you understand and put into practice.


----------



## Prashant1211 (Nov 20, 2022)

rollis13 said:


> Wasn't supposed to fix issues, my second sentence told you to do what Logit's macro did for you, it was up to you understand and put into practice.


Hi rollis13, i understand, many thanks for your guidance.


----------



## Prashant1211 (Jan 5, 2023)

Hi rollis13

I am trying since long but unable to run it as required. Below code copies the data to sheet1 but after that i am not getting how to populate list box, select the values from it and then delete the remaining. 

below is my code. Can you please guide how to proceed further. Thank you

---

Private Sub CommandButton1_Click()
Dim answer As Integer

If Range("A12").Value >= 1 Then

    answer = MsgBox("Project data already Exist, Reset Application ?", vbQuestion + vbYesNo)

If answer = vbYes Then

Call Reset


 Else

Exit Sub

End If
End If


On Error Resume Next

Dim FileToOpen As Variant
Dim OpenBook As Workbook
Dim LastRow As Long
Application.DisplayAlerts = False
Application.ScreenUpdating = False
    FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files (*.xls*),*xls*")
    If FileToOpen = False Then Exit Sub
        Set OpenBook = Application.Workbooks.Open(FileToOpen)
        LastRow = ActiveSheet.UsedRange.Rows.Count
        OpenBook.Sheets(1).Range("A1:J1" & LastRow).Copy
          ThisWorkbook.Worksheets("Main Sheet").Activate
          Sheets.Add(After:=Sheets("Main Sheet")).Name = "Sheet1"
Sheets("Sheet1").Select
          ActiveSheet.Paste

          'start
          Sheets("Sheet1").Select
          With Selection
          Dim g As Integer
          Dim k As Integer
          Dim l As Integer
          g = Application.WorksheetFunction.CountA(Sheets("Sheet1").Columns(1))
k = Application.WorksheetFunction.CountA(Sheets("Sheet1").Columns(5))
l = k - g


If l > 0 Then
answer = MsgBox("Insgesamt " & l & " nicht verpackte Artikel.Möchten Sie fortfahren?" & vbNewLine _
& "wenn Sie fortfahren, werden die ausgepackten Artikel nicht berücksichtigt", vbQuestion + vbYesNo)

   If answer = vbYes Then

   Application.ScreenUpdating = False
Sheets("Sheet1").Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Application.ScreenUpdating = True

Else

Call Reset
OpenBook.Close False
Exit Sub

End If
End If
End With

          'end


          OpenBook.Sheets(1).Activate

           Dim sht As Worksheet
Dim shtName As String
Dim i As Long

i = Sheets.Count
For i = 1 To i

If Sheets(i).Name = "Colidata" Then


          OpenBook.Sheets("Colidata").Range("A1:J1" & LastRow).Copy
          ThisWorkbook.Worksheets("Summary").Range("A5").PasteSpecial Paste:=xlPasteValues
          OpenBook.Sheets("Colidata").Range("F1").Copy
          ThisWorkbook.Worksheets("Summary").Range("P2").PasteSpecial Paste:=xlPasteValues

          End If

Next i

          ThisWorkbook.Worksheets("Main Sheet").Activate

        Range("Y1").Select
    ActiveCell.FormulaR1C1 = "='Sheet1'!R[1]C[-22]"
    Range("Y2").Select

   ActiveCell.FormulaR1C1 = "=""S.""&LEFT(R[-1]C[0],9)"
  Range("Y2").Copy
    Range("B5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

        ThisWorkbook.Worksheets("Sheet1").Activate


----------



## rollis13 (Jan 5, 2023)

Sorry, but this question has nothing to do with the topic of this thread. I suggest you open a new thread with an appropriate title so that you'll have a better chance of receiving a response.


----------

