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

J

jae113

Board Regular
Joined
Jun 17, 2008
Messages
227
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
Click to expand...
 

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
Sort by date Sort by votes
Hi jae113,

The code can be tightened up significantly and you shouldn't need to create additional modules due to its size.

You have many repeated processes that could be converted to loops or function calls with parameters for each sheet.

For speed of execution, I'd suggest eliminating the PageSetup/Printer steps and instead use a worksheet template that has already been saved with those desired settings.

For Sheet1, the code shows that all PivotItems are set to Visible, then about 15 PivotItems are made Hidden.
If the intent to make certain items Visible, then that should be inverted to Hide everything then make Visible the items you want to show.
Is that the case, and if so, which PivotItems do you want Visible?

If you provide that information for the first two sheets, I'd be glad to help you clean up the code you've posted and you can extend the pattern for all 18 worksheets.

Lastly, it looks like you're using xl2010. Is that correct?
 
Last edited:
Upvote 0
Thanks JS411! I would really appreciate the help!

Yes, I am using 2010. I don't know loops, although I have read a few posts about them. Unfortunately, I can't use a default worksheet. I wanted to, but not everyone who sees or uses the reports has the same version of Excel and/or Windows, and it must cause some sort of problem with opening the doc etc. Unless I did something wrong when creating it, which is very possible!

I do want to hide everything and only make a few visable! Thank you so much - if you could show me how to do that, I would be so grateful! I got the All - Visable = False code by recording the macro. Unfortunately, it won't work for some of the other pivots because there a too many variables and they change all the time.

Thanks very much for the help. I really appreciate it!
 
Upvote 0
So I was able to fix the "by Vendor" pivot report filter. I got this:
'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
Click to expand...

Down to this:
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"). _
EnableMultiplePageItems = True
ActiveSheet.PivotTables("SamplePivot").PivotFields("MARKET_FOCUS_GROUP").CurrentPage = "EDUCATION"
Click to expand...

I'm learning!
 
Upvote 0
That's a start in the right direction. :)

Below is some code that shows an approach you can take to breaking your large, only getting larger Sub into reuseable parts.

For this first pass, I've taken out the Page Setup code which we can put in a separate procedure and call from this Sub.

Rich (BB code): 
Sub Monthly_Pivots()
    Dim sDataR1C1 As String
    Dim PRange As Range
    Set PRange = Sheets("Data").Cells(1).CurrentRegion
    sDataR1C1 = "Data!" & PRange.Address(True, True, xlR1C1)
    Application.ScreenUpdating = False
    
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
        SourceData:=sDataR1C1).CreatePivotTable _
        TableDestination:="Sheet1!R3C1", TableName:="SamplePivot"
        
    With Sheets("Sheet1").PivotTables("SamplePivot")
        .ShowDrillIndicators = False
        .TableStyle2 = ""
        .RowAxisLayout xlTabularRow
        .AddDataField .PivotFields("ORIG_TRAN_AMT"),  _
            "Sum of ORIG_TRAN_AMT", xlSum
        .PivotFields("Sum of ORIG_TRAN_AMT").NumberFormat =  _
            "$#,##0.00_);[Red]($#,##0.00)"
    End With
    
    '----Page Setup
    'Call Apply_Page_Setup("Sheet1")
 
    '----------------Parameters (SheetName, PageField, CurrentField)
  Call Make_New_Sheet_wPivot("Suppliers", "MARKET_FOCUS_GROUP", "EDUCATION")
  Call Make_New_Sheet_wPivot("No Approvers", "MARKET_FOCUS_GROUP", "OTHERPAGE1")
  Call Make_New_Sheet_wPivot("By Approver", "MARKET_FOCUS_GROUP", "OTHERPAGE2")
    '---continue for rest of sheets...    
End Sub

Here's a start of a Function you can call to create each New Sheet.
This example makes takes 3 Parameters and creates a new sheet with a PivotTable with a Current Page set for the specified Field.
Rich (BB code): 
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 With
End Function

Based on what you are going to do with your 18 sheets, this could be modified to filter for X number of PageFields and Y number of RowFields,
where X and Y could be a fixed or variable number of arguments.

Give it a try and let me know if you want to pursue this approach.

The next step would be for you to think about and decide what functions you want your Make_New_Sheet_wPivot function to do for each sheet.
 
Upvote 0
Thanks Jerry, I can't wait to start! My name is Jenna by the way, nice to meet you :)

Can I ask a few questions about this code?

How come I don't have to use the FinalRow FinalColumn commands to get the entire sheet? It looks like
Dim PRange As Range
Set PRange = Sheets("Data").Cells(1).CurrentRegion
sDataR1C1 = "Data!" & PRange.Address(True, True, xlR1C1)
Click to expand...
is replacing it, but how? THe columns are always the same, but the number of rows change all the time so I thought I need the end xl commands?

How does Call work? Will it use the existing pivot cache that we created previously in the code? How do the parameters work? I see that you have SheetName, PageField, CurrentField, what's the difference between PageField and CurrentField? Will Sum of Trans still be in the called pivots, or added to each one?

I'm definately going to be using this today and I will also be looking up a lot of the variable etc while you're at work. Hopefully I'll have a better idea of some of the questions I just asked you when you sign on later!

Thanks so much! I'll get on this!

p.s. I looked at some of that other code from the link you sent yesterday and I will also look at the formating function when I make new sheets.
 
Upvote 0
Hi Jenna, nice to meet you, too :)

jae113 said:
How come I don't have to use the FinalRow FinalColumn commands to get the entire sheet? It looks like is replacing it, but how? THe columns are always the same, but the number of rows change all the time so I thought I need the end xl commands?
Click to expand...

Range.CurrentRegion is a convenient and concise way to grab all the continguous cells that make up your data source.

If your data range has any entire rows that are blank, you'd want to use a technique like the LastRow,LastColumn you had instead.

Typically that won't be the case if you have a clean data source.

The CurrentRegion will extend to the last continguous row, so that's why it works even if the number of rows varies each time you run the macro.

jae113 said:
How does Call work? Will it use the existing pivot cache that we created previously in the code? How do the parameters work?[/COLOR]
Click to expand...
Call just executes the function, in this case, it tells Excel to do the Make_New_Sheet_wPivot function to create a New Sheet by copying your existing Sheet1.

The parameters pass data to this function that it then uses to rename the New Sheet and filter the specified Field.

Because this function starts by copying an existing PivotTable, it will use the existing PivotCache instead or making a new one.

jae113 said:
What's the difference between PageField and CurrentField? Will Sum of Trans still be in the called pivots, or added to each one?
Click to expand...
PageField is a Field in the Page or "Report" section of the PivotTable.
CurrentPage (not CurrentField) is used to filter the report to show only data that has that Value in that Pagefield.

Running the statement...
Code: 
PivotField("MARKET_FOCUS_GROUP").CurrentPage = "EDUCATION"
...Is equivalent to clicking on EDUCATION in the Report Filter when "Select multiple items" is unchecked.
 
Upvote 0
While working with it, I noticed that the code you sent me is a .cls

Why is that? I read this post, and it sounds like for what you would like to do that the file needs to be cls, but I don't understand everything in the post. http://forums.devx.com/showthread.php?t=67180

Also, I had to put Sheets.Add after the Dims and before the first bit of code for the begining to work.

I'm learning a lot though!
 
Upvote 0
That's awesome with CurrentRegion! I'm totally using that!

I have to make a function for
Call just executes the function, in this case, it tells Excel to do the Make_New_Sheet_wPivot function to create a New Sheet by copying your existing Sheet1.
Click to expand...
, right?

Cause so far it doesn't like it, but then I realized I hadn't made anything like that function ;)
 
Upvote 0
jae113 said:
While working with it, I noticed that the code you sent me is a .cls

Why is that? I read this post, and it sounds like for what you would like to do that the file needs to be cls, but I don't understand everything in the post. http://forums.devx.com/showthread.php?t=67180

Also, I had to put Sheets.Add after the Dims and before the first bit of code for the begining to work.

I'm learning a lot though!
Click to expand...


Jenna, Was this message intended for this thread? I didn't send you any files.
 
Upvote 0
You must log in or register to reply here.

Similar threads

Cubist
  • Solved
VBA - Need help optimize code that's updating pivot tables.
Replies
1
Views
151
Cubist
Cubist
U
  • Solved
VBA question involving 2 different workbooks
Replies
2
Views
445
ummjay
U
T
  • Question
VBA Calculated Field - Subtract Value in Data Field from Value in Row Field
Replies
0
Views
313
th259
T
B
  • Question
Pivot table: iterating through each item takes forever
Replies
2
Views
149
RoryA
RoryA
C
  • Question
VBA code stuck (extract data from worksheet)
Replies
1
Views
154
Alex Blakenburg
A

Forum statistics

Threads
1,217,392
Messages
6,136,328
Members
450,005
Latest member
BigPaws

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top