Avoiding The Creation of A Bloated Excel File

[Ark68]

I have this code that will:

a) create a new workbook
b) filter the source data in a second open workbook
c) copy the filtered results to the empty worksheet (ws_data) in the new workbook

The code runs well, however, the resulting new file is heavily bloated! With a (visible) range of data occupying A1:W71, the file is 20059kb in size. CTRL-END shows the last cell of the range to be W1048208.

Is anyone able to comment on what may be causing this bloat. It must be the way data is being copied and pasted between workbooks. The source file is only 149kb. Is there a better way to to this avoiding whatever is causing the bloat? If not, a means to reduce the size of the file to a more manageable one. Deleting the rows each time a new workbook is created may be an awkward and time consuming task, so I'd prefer to take a preventative approach rather than reactive if I could.

        For x = 1 To intCount '{2}
            .Range("AH" & x) = DateValue(Right(.Range("AG" & x), 6))
            'trgt_date = .Range("AH" & x)
            trgt_date = "8/11/2016"
            str_nwb = Format(trgt_date, "MMM-DD (DDD)") & " schedule_1.xlsx"
            Workbooks.Add
            With ActiveWorkbook
                Sheets("Sheet1").Name = "DATA"
                Sheets("Sheet2").Name = "STAFF"
                Sheets("Sheet3").Name = "DEV"
                .SaveAs "H:\PWS\Parks\Parks Operations\Sports\Sports17\DATA\" & str_nwb
                Set wb_nwb = Workbooks(str_nwb)
                Set ws_data = wb_nwb.Worksheets("DATA")
                Set ws_staff = wb_nwb.Worksheets("STAFF")
                Set ws_dev = wb_nwb.Worksheets("DEV")
            End With
            Windows(str_nwb).Visible = False
            'filter database
            With ws_sched
                .Range("A1").AutoFilter _
                    Field:=2, _
                    Criteria1:=trgt_date, _
                    VisibleDropDown:=False
                Set srng = .Cells.SpecialCells(xlCellTypeVisible)
                srng.Copy ws_data.Range("A1")
                If ws_sched.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
            End With

 

[Michael M]

Hmm, seems like the suggested solutions haven't been much help.
As a last resort, you could upload the workbook to dropbox and someone might download and have a further look at it !!

 

[Ark68]

Thank you for all your help Michael.

My project is pretty complicated and requires additional supporting worksheets (not to mention having to rid of sensitive data which in turn will result in errors throughout the project). It would be too much to expect the kind folk here to have to fiddle through all that.
I don't admit to being anywhere close to being proficient in Excel VBA. I learn mostly by trial and error and doing my own online resaerch, and of course learning from the kind support given here. Because of my lack of knowledge, my project is very linear, and uses very rudimentary concepts.

I've provided pretty much everything that gets the file to this point (which is early on in the project).

 

[Michael M]

The code I provided in post #10 has always worked for me, so it not working surprises me !!
There is a more elaborate version here that cleans up pretty well

VBA Express : Excel - Reduce Excel File Size

You could put this code in it's own module and then call it from you main macro
So the 2nd last line of your main macro would be

Sub your macro

,,,,all your code

call ExcelDiet
end sub

However,have you considered using file compression to see if that helps...there are quite a number of free options on Google

 

[Ark68]

Hi Mike ... it makes me feel uneasy when I have a unique situation that others can't replicate. I feel like its my imagination or I'm messed up on something so basic. Thanks for enduring the mission.
I have implemented the solution you suggested. LOL ... it took just shy of 30 seconds to execute this code.

Unfortunately, it failed to complete stopping with an error: "Delete method of Range class failed." with this line ...

            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

The values I am receiving after running this code:
lastcol = 13
.rows.count = 1048576
.columns.count = 16384
lastrow = 18

I admit to not knowing how this code works other than to delete any unnecessary rows and columns.
I'm finding the lastrow of 18 being odd. 18 is the last row of the 2nd worksheet. All the other numbers are from the 1st, and presumably offending, worksheet. It's last row is 41.

Anyone able to siuggest a solution to why I can't delete the columns?

 

[MARK858]

First thing to test is if you can delete them manually.
First with the whole range and then if you can't with a block of columns at a time to try and narrow the issue down.

 

[Ark68]

Augh! It doesn't seem to want to let me delete the rows. It just keeps telling me its too much to delete at once. It asks if I want to continue without undo, and I proceed, but nothing deletes.

If anyone wants to analyze the troublesome file ... go crazy.

https://drive.google.com/file/d/0B9EE-tbOy4bJNVVjaWlBZUc5N2s/view?usp=sharing

 

[Ark68]

Posted in error

 

[Ark68]

I think I may be onto something ...

During my data manipulation of the source data ...

With ws_sched
        norec = WorksheetFunction.count(.Range("M:M"))                                      'count number of records
        llastrow = .Cells(Rows.count, 2).End(xlUp).Row                                      'last row of data
    
        msga = "Refining raw dataset.  " & norec & " records."
        msgb = "Adding data columns"
        msg1 = vbLf & msga & vbLf & msgb
        uf1_create_wo1.F6E_msg13.Caption = msg1
    
        If .Range("A2") <> "" Then                              'blank line already exists?
            .Rows(1).Insert Shift:=xlShiftDown                  'insert blank row into schedule.csv (header row)
        End If
        
        .Range("M1:X1").Value = .Range("A2:L2").Value                           'create headers (M1:X1) from redundant data (A2:L2)
        .Columns("A:L").EntireColumn.Delete                                     'delete redundant columns of data
        .Columns.AutoFit

I am discovering that even though columns A:L are being deleted, they are still showing up in the usedrange. CTRL-END focus on cell X719. Row 719 is the last row with data in it. The last column with data in it though is L. Columns M through X are empty.
I don't think I'm deleting things properly.

 

[Ark68]

Further to my previous observation ...

As the code progresses, I add columns. As I add columns, the range of 12 empty columns continues to the right as part of the usedrange. By the time all is said and done, the range of empty columns is from X:AH

And ... here's where you are going to kick me.

this line in blue,

.Columns(3).EntireColumn.Insert                                                     'insert a column at C
        .Range("C:C").Value = .Range("F:F").Value                                           'copy column F to newly created C
        .Columns(3).NumberFormat = "######"                                                 'define contract# format (######)
        .Columns(3).EntireColumn.AutoFit                                                    'autofit
        .Columns(6).EntireColumn.Delete

despite your advice in post #19 that I overlooked, seems to be the part of the culprit in the addition of thousands of unwanted rows. It appears to do more than just slow the code down. I figure I have this similar of code throughout my data manipulation portion of my code.

So, having potentially isolated the causes ...
a) how do I properly delete the columns? and,
b) change the line above in blue to a defined range

With cleaning up these, I think the used range will be more appropriately defined.

 

[NoSparks]

Re: #28 Using an array would prevent that

        '.Range("M1:X1").Value = .Range("A2:L2").Value           'create headers (M1:X1) from redundant data (A2:L2)
        arr = .Range("A2:L2").Value
        .Columns("A:L").EntireColumn.Delete                     'delete redundant columns of data
        .Range("A1:L1").Value = arr
        .Columns.AutoFit