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

 

[Ark68]

I am also finding that residual rows are being left behind after I delete rows resulting from a filter.

.Range("A:W").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=ws_vh.Range(ws_vh.Cells(9, 1), ws_vh.Cells(rn_t, cn_t))
         .Range("A:W").Resize(Rows.count - 1).offset(1).EntireRow.Delete Shift:=xlUp

The original database has 719 records. After I delete the 302 rows of filtered data, the usedrange includes 302 empty rows.

 

[NoSparks]

The original database has 719 records. After I delete the 302 rows of filtered data, the usedrange includes 302 empty rows.

As Mark858 stated in #15 filtering doesn't change the used range.
Why not? Because the rows being deleted are not after the data, they are within the data.

 

[MARK858]

It ain't fast but the 2 codes below reset your range on the Data sheet (make sure it is the activesheet) and then your sheet as an xlsm is 26.1kb for me.

I haven't the time to work out the issue yet.

Sub xxxx()
    Dim x As Long
    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .DisplayStatusBar = False
        .EnableEvents = False
    End With
    ActiveSheet.DisplayPageBreaks = False
    x = 1
    Do While x < 20
        Cells(1, 71).Resize(, 100).EntireColumn.Delete
        x = x + 1
    Loop
    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
        .DisplayStatusBar = True
        .EnableEvents = True
    End With
    ActiveSheet.DisplayPageBreaks = True
End Sub


Sub xxxx2()
    Dim x As Long
    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .DisplayStatusBar = False
        .EnableEvents = False
    End With

    ActiveSheet.DisplayPageBreaks = False

    x = 1
    Do While x < 106
        Cells(42, 1).Resize(10000).EntireRow.Delete
        x = x + 1
   Loop
    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
        .DisplayStatusBar = True
        .EnableEvents = True
    End With
    ActiveSheet.DisplayPageBreaks = True
End Sub

 

[Ark68]

As Mark858 stated in #15 filtering doesn't change the used range.
Why not? Because the rows being deleted are not after the data, they are within the data.

Thank you folks for you're continued efforts. Clearly I;m struggling with grasping the concept of what a used range really is. I've been assuming the used range is the group of cells defined by A1 to wherever the identified cell is when CTRL END is used. I am always waiting for that cell to be in the bottom rightmost cell holding data and excluding any empty rows or columns. In my case, the used range, after removing filtered rows would be A1:M399. Copying and pasting the used range then would be A1:M399 of only data, no blank rows or columns left from previous deleting.

BTW NoSparks, I have integrated your suugestion in post #30 into my code. Thank you!

Mark, I'm excited to apply your latest suggestion. Do I need to execute both procedures? Are they written specific to the workbook I provided, or will they work dynamically on others of similar development?

 

[MARK858]

You need to run both codes and at the moment it is specific to that workbook.

Tomorrow night I will see if we can use something like the current region (what it sounds like you think of as the used range) to get the range of data.

You might want to get a couple of pints ready for waiting for the codes to run

 

[Ark68]

Still working line by line to isolate exactly where things go wonky.
The source data workbook is 'schedule.csv' (ws_sched)

CTRL-END results in cell AH719 being identified prior to this code being executed ...

With ws_sched
                .Activate
                .Range("A1").AutoFilter _
                    Field:=2, _
                    Criteria1:=trgt_date, _
                    VisibleDropDown:=False
                'Set srng = .Range(.Cells(1, 1), .Cells(.Range("A" & Rows.count).End(xlUp).Row, .Cells(1, Columns.count).End(xlToLeft).Column))
                Set srng = .Cells.SpecialCells(xlCellTypeVisible)
                '.UsedRange.Copy ws_data.Range("A1")
                srng.Copy ws_data.Range("A1")
                If ws_sched.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
            End With

After the filter is applied, and prior to setting range srng, CTRL-END on ws_sched still registers AH719.

However, after

srng.Copy ws_data.Range("A1")

CTRL-END on ws_sched shots AH1048208 as does the target worksheet.

Worth anything?

 

[MARK858]

What happens if you replace that block of code with...

    With ws_sched
        .Range("A1").AutoFilter _
                Field:=2, _
                Criteria1:=trgt_date, _
                VisibleDropDown:=False
        Set srng = .Range(.Cells(1, 1), .Cells(.Range("A" & Rows.Count).End(xlUp).Row, .Cells(1, Columns.Count).End(xlToLeft).Column))
        srng.SpecialCells(xlCellTypeVisible).Copy ws_data.Range("A1")
        If .AutoFilterMode Then .AutoFilterMode = False
    End With

 

[Ark68]

What happens if you replace that block of code with...

Only the header row, row 1, is copied to the destination worksheet.
The source worksheet doesn't show AH1048208 with CTRL-END, nor does the target worksheet.

 

[MARK858]

and with...

    With ws_sched
        Set srng = .Range(.Cells(1, 1), .Cells(.Range("A" & Rows.Count).End(xlUp).Row, .Cells(1, Columns.Count).End(xlToLeft).Column))
        srng.AutoFilter _
                Field:=2, _
                Criteria1:=trgt_date, _
                VisibleDropDown:=False
        srng.SpecialCells(xlCellTypeVisible).Copy ws_data.Range("A1")
        If .AutoFilterMode Then .AutoFilterMode = False
    End With

 

[Ark68]

Mark ...
Looks like you got it friend!

I'm not going to call it success yet (I did that once alreadythis thread), but I am feeling good about it.
The code is running significant faster, and only the data thats supposed to be in the destination workbook is there. File size is 21KB, and CTRL-END nets an accurate data range ending at EH42.

I can only repay you in sincere thanks and a virtual pint. Your effort is greatly appreciated.