Very large Module, only getting larger. Suggestions for cutting it down?

[jae113]

Hi All,

I have a data sheet that I use to create 18 pivot tables (yes, there is a lot of redundancy, but that's what the higher-ups want). To keep the size of the file down, I create one pivot table and copy it 17 times. I would like to now start filling out some of those pivot tables. I have a few done, but the macro is so slow and I can't imagine that it will continue working if I keep adding to the module.

I know I have seen a way to split the module into parts and then run the different parts. I think it was by having a line at the end of each macro telling it to open the next, but I'm not sure and can't find the post again.

Does that seem like a solution?

Could someone look at what I have and give suggestions for cleaning up and speeding up the macro?

I don't really know VBA at all, I'm learning as I go along. I really appreciate the help. Thanks!

Attribute VB_Name = "Monthly_Pivot_Pages2"
Sub Monthly_Pivots2()
Attribute Monthly_Pivots2.VB_Description = "Creates one basic pivot, with only Sum of Amount, print formats, then copies that page 18 times"
Attribute Monthly_Pivots2.VB_ProcData.VB_Invoke_Func = " \n14"
'
' Monthly_Pivot_Pages2 Macro
' Creates one basic pivot, with only Sum of Amount, print formats, then copies that page 18 times and names each tab to the pivot table
'
'
Dim WSD As Worksheet
Set WSD = Worksheets("Data")

Dim finalRow As Long
finalRow = WSD.Cells(Application.Rows.Count, 1).End(xlUp).Row
Dim finalCol As Long
finalCol = WSD.Cells(1, Application.Columns.Count).End(xlToLeft).Column

Dim PRange As Range
Set PRange = WSD.Cells(1, 1).Resize(finalRow, finalCol)

With Application
.ScreenUpdating = False
End With


Sheets.Add
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
PRange, Version:=xlPivotTableVersion14).CreatePivotTable _
TableDestination:="Sheet1!R3C1", TableName:="SamplePivot", DefaultVersion _
:=xlPivotTableVersion14
Sheets("Sheet1").Select
Cells(3, 1).Select
Range("B18").Select
ActiveSheet.PivotTables("SamplePivot").ShowDrillIndicators = False
ActiveSheet.PivotTables("SamplePivot").TableStyle2 = ""
ActiveSheet.PivotTables("SamplePivot").RowAxisLayout xlTabularRow
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = "&A"
.RightHeader = ""
.LeftFooter = "&F"
.CenterFooter = "&P of &N"
.RightFooter = "&D &T"
.Orientation = xlPortrait
.FitToPagesWide = 1
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
End With
ActiveSheet.PivotTables("SamplePivot").AddDataField ActiveSheet.PivotTables( _
"SamplePivot").PivotFields("ORIG_TRAN_AMT"), "Sum of ORIG_TRAN_AMT", xlSum
With ActiveSheet.PivotTables("SamplePivot").PivotFields("Sum of ORIG_TRAN_AMT")
.NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"
End With
Sheets("Sheet1").Select
'Added this line 1/18
Range("A1").Select
'Try this to fix the FitTo issue
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = ""
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.FitToPagesWide = 1
.FitToPagesTall = False
End With

Sheets("Sheet1").Copy Before:=Sheets(1)
Sheets("Sheet1 (2)").Select
Sheets("Sheet1 (2)").Copy Before:=Sheets(1)
Sheets("Sheet1 (3)").Select
Sheets("Sheet1 (3)").Copy Before:=Sheets(1)
Sheets("Sheet1 (4)").Select
Sheets("Sheet1 (4)").Copy Before:=Sheets(1)
Sheets("Sheet1 (5)").Select
Sheets("Sheet1 (5)").Copy Before:=Sheets(1)
Sheets("Sheet1 (6)").Select
Sheets("Sheet1 (6)").Copy Before:=Sheets(1)
Sheets("Sheet1 (7)").Select
Sheets("Sheet1 (7)").Move Before:=Sheets(1)
Sheets("Sheet1 (7)").Select
Sheets("Sheet1 (7)").Copy Before:=Sheets(1)
Sheets("Sheet1 (8)").Select
Sheets("Sheet1 (8)").Copy Before:=Sheets(1)
Sheets("Sheet1 (9)").Select
Sheets("Sheet1 (9)").Copy Before:=Sheets(1)
Sheets("Sheet1 (10)").Select
Sheets("Sheet1 (10)").Copy Before:=Sheets(1)
Sheets("Sheet1 (11)").Select
Sheets("Sheet1 (11)").Copy Before:=Sheets(1)
Sheets("Sheet1 (12)").Select
Sheets("Sheet1 (12)").Copy Before:=Sheets(1)
Sheets("Sheet1 (13)").Select
Sheets("Sheet1 (13)").Copy Before:=Sheets(1)
Sheets("Sheet1 (14)").Select
Sheets("Sheet1 (14)").Copy Before:=Sheets(1)
Sheets("Sheet1 (15)").Select
Sheets("Sheet1 (15)").Copy Before:=Sheets(1)
Sheets("Sheet1 (16)").Select
Sheets("Sheet1 (16)").Copy Before:=Sheets(1)
Sheets("Sheet1 (17)").Select
Sheets("Sheet1 (17)").Copy Before:=Sheets(1)
'Testing to add more of the pivot fields into the macro


'by Vendor
Sheets("Sheet1").Select
With ActiveSheet.PivotTables("SamplePivot").PivotFields("MARKET_FOCUS_GROUP")
.Orientation = xlPageField
.Position = 1
End With
ActiveSheet.PivotTables("SamplePivot").PivotFields("MARKET_FOCUS_GROUP"). _
CurrentPage = "(All)"
With ActiveSheet.PivotTables("SamplePivot").PivotFields("MARKET_FOCUS_GROUP")
.PivotItems("BENCHMARKS").Visible = False
.PivotItems("BUSINESS").Visible = False
.PivotItems("CONTINUING").Visible = False
.PivotItems("CORPORATE").Visible = False
.PivotItems("RATINGS").Visible = False
.PivotItems("DISCONTINUED").Visible = False
.PivotItems("SOLUTIONS").Visible = False
.PivotItems("HIGHER").Visible = False
.PivotItems("INTEGRATED").Visible = False
.PivotItems("DIVISIONAL").Visible = False
.PivotItems("OTHER").Visible = False
.PivotItems("MEDIA").Visible = False
.PivotItems("RESEARCH").Visible = False
.PivotItems("STANDARD").Visible = False
.PivotItems("SEGMENT").Visible = False
.PivotItems("FINANCE").Visible = False
End With
ActiveSheet.PivotTables("SamplePivot").PivotFields("MARKET_FOCUS_GROUP"). _
EnableMultiplePageItems = True
' All above is to set the filter
With ActiveSheet.PivotTables("SamplePivot").PivotFields("APPROVER")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables("SamplePivot").PivotFields("APPROVER"). _
AutoSort xlDescending, "Sum of ORIG_TRAN_AMT"
With ActiveSheet.PivotTables("SamplePivot").PivotFields("VENDOR_NAME")
.Orientation = xlRowField
.Position = 2
End With
ActiveSheet.PivotTables("SamplePivot").PivotFields("VENDOR_NAME").AutoSort _
xlDescending, "Sum of ORIG_TRAN_AMT"
Sheets("Sheet1").Name = "by Vendor"
Cells.Select
Cells.EntireColumn.AutoFit
Range("A2").Select

'MFG & MFN
Sheets("Sheet1 (2)").Select
With ActiveSheet.PivotTables("SamplePivot").PivotFields("MARKET_FOCUS_GROUP")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables("SamplePivot").PivotFields("MARKET_FOCUS_GROUP"). _
AutoSort xlDescending, "Sum of ORIG_TRAN_AMT"
With ActiveSheet.PivotTables("SamplePivot").PivotFields("MARKET_FOCUS_NAME")
.Orientation = xlRowField
.Position = 2
End With
ActiveSheet.PivotTables("SamplePivot").PivotFields("MARKET_FOCUS_NAME").AutoSort _
xlDescending, "Sum of ORIG_TRAN_AMT"
Sheets("Sheet1 (2)").Name = "MFG & MFN"
Cells.Select
Cells.EntireColumn.AutoFit
Range("A1").Select

'Non-Comp SG & Vendor
Sheets("Sheet1 (3)").Select
With ActiveSheet.PivotTables("SamplePivot").PivotFields("SOURCING_GROUP_DESC")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables("SamplePivot").PivotFields("SOURCING_GROUP_DESC"). _
AutoSort xlDescending, "Sum of ORIG_TRAN_AMT"
With ActiveSheet.PivotTables("SamplePivot").PivotFields("POSource")
.Orientation = xlRowField
.Position = 2
End With
With ActiveSheet.PivotTables("SamplePivot").PivotFields("POSource")
.PivotItems("A").Visible = False
.PivotItems("C").Visible = False
.PivotItems("E").Visible = False
.PivotItems("M").Visible = False
End With
ActiveSheet.PivotTables("SamplePivot").PivotFields("POSource"). _
EnableMultiplePageItems = True
' All above is to set the filter
ActiveSheet.PivotTables("SamplePivot").PivotFields("POSource").AutoSort _
xlDescending, "Sum of ORIG_TRAN_AMT"
With ActiveSheet.PivotTables("SamplePivot").PivotFields("VENDOR_NAME")
.Orientation = xlRowField
.Position = 3
End With
ActiveSheet.PivotTables("SamplePivot").PivotFields("VENDOR_NAME").AutoSort _
xlDescending, "Sum of ORIG_TRAN_AMT"
Sheets("Sheet1 (3)").Name = "Non-Compl by SG & Vendor"
Cells.Select
Cells.EntireColumn.AutoFit
Range("A1").Select
'Place
Sheets("Sheet1 (4)").Select
Sheets("Sheet1 (4)").Name = "Suppliers, No Approvers"
Sheets("Sheet1 (5)").Select
Sheets("Sheet1 (5)").Name = "By Approver "
Sheets("Sheet1 (6)").Select
Sheets("Sheet1 (6)").Name = "Invoices by MFN & PO Source"
Sheets("Sheet1 (7)").Select
Sheets("Sheet1 (7)").Name = "MFN by PO Source"
Sheets("Sheet1 (8)").Select
Sheets("Sheet1 (8)").Name = "Sector by PO Source"
Sheets("Sheet1 (9)").Select
Sheets("Sheet1 (9)").Name = "Transactions by PO Source"
Sheets("Sheet1 (10)").Select
Sheets("Sheet1 (10)").Name = "By PO Source"
Sheets("Sheet1 (11)").Select
Sheets("Sheet1 (11)").Name = "T"
Sheets("Sheet1 (12)").Select
Sheets("Sheet1 (12)").Name = "Other"
Sheets("Sheet1 (13)").Select
Sheets("Sheet1 (13)").Name = "Select Approvers"
Sheets("Sheet1 (14)").Select
Sheets("Sheet1 (14)").Name = "W"
Sheets("Sheet1 (15)").Select
Sheets("Sheet1 (15)").Name = "E"
Sheets("Sheet1 (16)").Select
Sheets("Sheet1 (16)").Name = "P"
Sheets("Sheet1 (17)").Select
Sheets("Sheet1 (17)").Name = "R"
Sheets("Sheet1 (18)").Select
Sheets("Sheet1 (18)").Name = "TL"

End Sub

 

[Jerry Sullivan]

That's awesome with CurrentRegion! I'm totally using that!

I have to make a function for , right?

Cause so far it doesn't like it, but then I realized I hadn't made anything like that function

You'll need to paste post sections of code that are shown in Post #5 of this thread to the same Standard Module.

 

[jae113]

Yes, sorry, I mispoke. I meant that when I copied the code you gave me into VB, it exported as a cls. Sorry.

I wanted to try out a loop, just to see, and I want to use the other code you suggested with the function:

Private Function Make_New_Sheet_wPivot(sSheetName As String, _ sField1 As String, sValue1 As String) Sheets("Sheet1").Copy After:=Sheets(Sheets.Count) With ActiveSheet .Name = sSheetName With .PivotTables("SamplePivot").PivotFields(sField1) .Orientation = xlPageField .CurrentPage = sValue1 End With End WithEnd Function</PRE>But I thought that whole copy sheet thing would be good practice for a loop and I got it to work using this:

Dim i As Integer
For i = 1 To 17
Sheets("Sheet1").Copy Before:=Sheets(1)
Next i

Which I think is pretty cool!

 

[Jerry Sullivan]

Yes, sorry, I mispoke. I meant that when I copied the code you gave me into VB, it exported as a cls. Sorry.

I wanted to try out a loop, just to see, and I want to use the other code you suggested with the function:

Private Function Make_New_Sheet_wPivot(sSheetName As String, _ sField1 As String, sValue1 As String) Sheets("Sheet1").Copy After:=Sheets(Sheets.Count) With ActiveSheet .Name = sSheetName With .PivotTables("SamplePivot").PivotFields(sField1) .Orientation = xlPageField .CurrentPage = sValue1 End With End WithEnd Function</PRE>But I thought that whole copy sheet thing would be good practice for a loop and I got it to work using this:


Which I think is pretty cool!

Nicely done! It is pretty cool, isn't it.

Regading the .cls, the code is intended to be pasted into a Standard Code Module inside of Excel's VBA Editor. You shouldn't copy it into a standalone file. I can post some more detailed instructions if needed.

Function calls and loops have some similarities, and sometimes one will have some advantages over the other.

For example, we can tweek your code and add a step to put in the sheet names from a Variant Array.

Sub TEST_LOOP()
    Dim i As Integer
    Dim vSheetNames As Variant
    
    vSheetNames = Array("Suppliers", "No Approvers", "By Approver", _
        "Invoices by MFN & PO Source", "MFN by PO Source",  _
        "Sector by PO Source", "Transactions by PO Source", _
        "By PO Source", "T", "Other", _
        "Select Approvers", "W", "E", "P", "R", "TL")
 
    For i = 0 To 15
        Sheets("Sheet1").Copy Before:=Sheets(1)
        ActiveSheet.Name = vSheetNames(i)
    Next i
End Sub

At first, this looks like it will be a great approach to doing all the things you want to do to customize each sheet, but it becomes more difficult to manage as you try to have an array list for your PivotField and another for your CurrentPage.

So even though you could get this to work with loops instead of function calls, I think the function calls will be easier to maintain.

 

[jae113]

I totally see it! I might need some help using the cls file actually. What I normally do is write in txt save a copy in bas and then import it. Oh no! I'm home now and don' t have the data file to test with!! Sugar Honey Iced Tea! Let me see if i can get my boss to email it to me. He can access from home