Function causing created file to bloat? 1

[VBAjedi]

I hate posting large chunks of code, but. . .

The following function is supposed to copy a worksheet object ("ShSD&quot to a new workbook and subtotal/format it (with an optional re-sort and print/close). For some reason, the new document is huge (like 2,000k when there is less than 100k of data present).

I can only assume the function is somehow bloating the file (it's a repeatable problem on different machines). The arguments I pass it are False,False,False :

Function MakeDetailReport(Outdoor As Boolean, PrintCopy As Boolean, KillFile As Boolean)
Dim MainWorkbookName As String, NewWorkbookName As String
Dim ReportTitle As String
Dim LastRptRow As Integer, LastRptCol As Integer
Dim DataRange As Range
Dim x, y

AssignSheets
MainWorkbookName = ActiveWorkbook.Name
ReportTitle = ShAB.Range("ABReportTitle").Value

ShSD.Activate
Range("SDDataAndHeaders").SpecialCells(xlCellTypeVisible).Copy
Workbooks.Add
NewWorkbookName = ActiveWorkbook.Name

Range("A5").Select
' Paste Values and Formats only:
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=False
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=False

' Define DataRange
LastRptCol = Selection.Columns.Count
LastRptRow = ActiveSheet.Cells.Find(What:="*", After:=Range("IV65536"), _
    SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Set DataRange = ActiveSheet.Range("A5", Cells(LastRptRow, LastRptCol))
' Sort and Subtotal by user preference
If Not Outdoor Then ' selected "No", sort/subtotal for Transit
   DataRange.Sort Key1:=Range("E6"), Order1:=xlAscending, Key2:=Range("G6" _
       ), Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
       False, Orientation:=xlTopToBottom
   ' Subtotal by Contract Type
   DataRange.Subtotal GroupBy:=5, Function:=xlSum, TotalList:=Array(18, 19, 20 _
   , 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31), Replace:=True, PageBreaks:=False, _
   SummaryBelowData:=True
Else ' Outdoor is true, sort by Level 3, Lease Location and # for Outdoor
   DataRange.Sort Key1:=Range("C6"), Order1:=xlAscending, Key2:=Range("L6" _
       ), Order2:=xlAscending, Key3:=Range("M6"), Order3:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
       False, Orientation:=xlTopToBottom
   ' Subtotal by Level3
   DataRange.Subtotal GroupBy:=3, Function:=xlSum, TotalList:=Array(18, 19, 20 _
   , 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31), Replace:=True, PageBreaks:=False, _
   SummaryBelowData:=True
End If

With DataRange.Borders
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
End With

' Move Header info over and delete Level columns 1 & 2
With Range("C1")
   .Value = ReportTitle
   .Font.Size = 14
   .Font.Bold = True
   .Font.Underline = True
End With
Range("C2").Value = "Generated " & Now
Columns("A:B").Delete

' Apply page formatting, print, and close if requested
With ActiveSheet.PageSetup
   .Orientation = xlLandscape
   .PaperSize = xlPaperLegal
   .PrintArea = "A:AC"
   .Zoom = False
   .FitToPagesWide = 1
   .FitToPagesTall = False
End With
If PrintCopy Then
   ActiveSheet.PrintOut
End If
If KillFile Then
   Workbooks(NewWorkbookName).Saved = True
   Workbooks(NewWorkbookName).Close SaveChanges:=False
End If
End Function

Thanks for any input you can give!



VBAjedi

 

[RobBroekhuis]

Nothing stands out. Have you tried to see what happens if you don't paste the formats? Try to "stop" the code in a few places and see how the file size develops. What is the activesheet.usedrange.address for the new sheet?


Rob

 

[Chattin]

Generic rather than specific help here and not all VBA related

http://www.ozgrid.com/Excel/ExcelProblems.htm

http://www.mvps.org/dmcritchie/excel/lastcell.htm

Also try the VBA Code Cleaner from

http://www.appspro.com/

HTH

Chris ;-)

Visit

http://www.mrexcel.com/board/index.php

for great xl and xl/VBA help

 

[VBAjedi]

Hah. Good call, Rob! Used Range: $A$1:$AB$60000

That'll add some bloat to an otherwise small spreadsheet!

My source range is defined as ending in row 60000 to allow for large datasets. I thought grabbing visible rows would not copy the empty rows after the last row with contents (because the filter is active on them), but now that I think about it they are still visible (even though their row#s are blue indicating the filter is active) .Guess I need to find the last POPULATED row of my source range before I copy it.

Thanks for the help!


VBAjedi