Shorten Pivot Table VBA.

N

Nanogirl21

Active Member
Joined
Nov 19, 2013
Messages
331
Office Version
  1. 365
Platform
  1. Windows
Hi,

Can someone please help shorten this code.

Thank you.

Code: 
    Sheets("SMMRY - WO BY DAYS IN ROLE").Select
    Set pvt = ActiveSheet.PivotTables("PivotTable1")
    pvt.ColumnGrand = False
    pvt.RowGrand = False
    pvt.RowAxisLayout xlTabularRow
    pvt.ClearTable
    
'FILTERS
    'FALSE IS ITEMS I DON'T WANT TO SEE
    Set pvt = ActiveSheet.PivotTables("PivotTable1").PivotFields("CCC Affected WO Fltr")
    pvt.EnableMultiplePageItems = True
    pvt.PivotItems("No").Visible = False
    
    Set pvt = ActiveSheet.PivotTables("PivotTable1").PivotFields("GFLT")
    pvt.EnableMultiplePageItems = True
    pvt.PivotItems("Powertrain").Visible = False
    
    Set pvt = ActiveSheet.PivotTables("PivotTable1").PivotFields("WO Type")
    pvt.EnableMultiplePageItems = True
    pvt.PivotItems("AWO").Visible = False
    pvt.PivotItems("BMB").Visible = False
    pvt.PivotItems("BSD").Visible = False
    pvt.PivotItems("CES").Visible = False
    pvt.PivotItems("MWO").Visible = False
    pvt.PivotItems("PSO").Visible = False
    pvt.PivotItems("SCE").Visible = False
    pvt.PivotItems("SWO").Visible = False
    pvt.PivotItems("TWO").Visible = False
    pvt.PivotItems("VWO").Visible = False
    
    Set pvt = ActiveSheet.PivotTables("PivotTable1").PivotFields("WO Sub Type")
    pvt.EnableMultiplePageItems = True
    pvt.PivotItems("01, * Accessory").Visible = False
    pvt.PivotItems("10, Asm Plant Process Chg").Visible = False
    pvt.PivotItems("11, * SOR").Visible = False
    pvt.PivotItems("12, * DLS Increment").Visible = False
    pvt.PivotItems("13, * MPL Correction").Visible = False
    pvt.PivotItems("15, ").Visible = False
    pvt.PivotItems("15, Further Tooling Release").Visible = False
    pvt.PivotItems("16, * Dwg Chg No Dsgn Effect").Visible = False
    pvt.PivotItems("19, Drwg Chg, Dsgn Effected").Visible = False
    pvt.PivotItems("21, * U Release").Visible = False
    pvt.PivotItems("23, AWO-Engr Code Maint Req").Visible = False
    pvt.PivotItems("24, Initial PAD/MPP Release").Visible = False
    pvt.PivotItems("25, * Color Release").Visible = False
    pvt.PivotItems("26, ").Visible = False
    pvt.PivotItems("26, CES - To GMPT").Visible = False
    pvt.PivotItems("30, ").Visible = False
    pvt.PivotItems("30, Service Chg Understudy").Visible = False
    pvt.PivotItems("31, Service Modify Create").Visible = False
    pvt.PivotItems("35, Production").Visible = False
    pvt.PivotItems("36, Pre-Production").Visible = False
    pvt.PivotItems("37, Tooling").Visible = False
    pvt.PivotItems("39, * S Release").Visible = False
    pvt.PivotItems("40, Pwrtrn - Source Chg").Visible = False
    pvt.PivotItems("A0, Cost Approval Only").Visible = False
    pvt.PivotItems("A1, ").Visible = False
    pvt.PivotItems("A1, Init Tooling Release").Visible = False
    pvt.PivotItems("A2, ").Visible = False
    pvt.PivotItems("A2, Init Production Release").Visible = False
    pvt.PivotItems("A3, ").Visible = False
    pvt.PivotItems("A3, Late Release").Visible = False
    pvt.PivotItems("A4, * Create").Visible = False
    pvt.PivotItems("A5, NPN Understudy").Visible = False
    pvt.PivotItems("A6, ").Visible = False
    pvt.PivotItems("A6, Change Understudy").Visible = False
    pvt.PivotItems("A7, Lift Order").Visible = False
    pvt.PivotItems("A9, Manufacturing Release").Visible = False
    pvt.PivotItems("AD, Admin. chg. blanket w.o.").Visible = False
    pvt.PivotItems("AM, Alt Cmpt Matl or Const.").Visible = False
    pvt.PivotItems("AN, ").Visible = False
    pvt.PivotItems("AP, Alternative Asm Process").Visible = False
    pvt.PivotItems("AR, ").Visible = False
    pvt.PivotItems("AS, ").Visible = False
    pvt.PivotItems("AU, ").Visible = False
    pvt.PivotItems("AX, ").Visible = False
    pvt.PivotItems("BC, BMB - BOM Change Request").Visible = False
    pvt.PivotItems("BO, ").Visible = False
    pvt.PivotItems("BOM, ").Visible = False
    pvt.PivotItems("BOM, BMB - BOM Change Request").Visible = False
    pvt.PivotItems("CD, Clean Dwg.").Visible = False
    pvt.PivotItems("DS, PSO - Design Study").Visible = False
    pvt.PivotItems("DT, ").Visible = False
    pvt.PivotItems("ET, Engineering Try Out").Visible = False
    pvt.PivotItems("EX, BMB - Expedited Tooling").Visible = False
    pvt.PivotItems("IM, ").Visible = False
    pvt.PivotItems("LL, Label Logic").Visible = False
    pvt.PivotItems("MC, Modify / Create").Visible = False
    pvt.PivotItems("MO, BMB - Misc Mat'l Order").Visible = False
    pvt.PivotItems("MP, ").Visible = False
    pvt.PivotItems("MS, Material Substitution").Visible = False
    pvt.PivotItems("MU, ").Visible = False
    pvt.PivotItems("NN, * Non Impact Notify-NIN").Visible = False
    pvt.PivotItems("NR, ").Visible = False
    pvt.PivotItems("OM, Obsolete Material").Visible = False
    pvt.PivotItems("PA, * Reference Usage Chg").Visible = False
    pvt.PivotItems("PM, BMB - Matl Req").Visible = False
    pvt.PivotItems("PO, ").Visible = False
    pvt.PivotItems("PR, ").Visible = False
    pvt.PivotItems("PS, ").Visible = False
    pvt.PivotItems("PT, BMB - Pre-Prod Tooling").Visible = False
    pvt.PivotItems("RE, ").Visible = False
    pvt.PivotItems("RP, ").Visible = False
    pvt.PivotItems("RP, Rework (Plant)").Visible = False
    pvt.PivotItems("RS, Rework (Source)").Visible = False
    pvt.PivotItems("SA, Static Torque").Visible = False
    pvt.PivotItems("SC, *Service Chg only").Visible = False
    pvt.PivotItems("SL, ").Visible = False
    pvt.PivotItems("SL, Special Projects").Visible = False
    pvt.PivotItems("SP, Dwg. chg. to dwg. spec.").Visible = False
    pvt.PivotItems("SR, ").Visible = False
    pvt.PivotItems("ST, Stop Order").Visible = False
    pvt.PivotItems("SU, ").Visible = False
    pvt.PivotItems("V1, VDS Corr No Prt Impact").Visible = False
    pvt.PivotItems("V2, VDS Administration").Visible = False
    pvt.PivotItems("V3, VDS Corr w/Part Impact").Visible = False
    pvt.PivotItems("VD, VDS chg. w/part impact").Visible = False
    pvt.PivotItems("VN, VDS Chg No Part Impact").Visible = False
    pvt.PivotItems("VP, VDS not Chg'g- Part Only").Visible = False
    pvt.PivotItems("WS, Work Share").Visible = False
  
'COLUMNS
Set pvt = ActiveSheet.PivotTables("PivotTable1")

    pvt.PivotFields("WO").Orientation = xlRowField
    pvt.PivotFields("LEAD WO").Orientation = xlRowField
    pvt.PivotFields("Product Line").Orientation = xlRowField
    pvt.PivotFields("YEAR").Orientation = xlRowField
    pvt.PivotFields("Prgrms").Orientation = xlRowField
    pvt.PivotFields("Engineering Region").Orientation = xlRowField
    pvt.PivotFields("GFLT").Orientation = xlRowField
    pvt.PivotFields("WO Subject").Orientation = xlRowField
    pvt.PivotFields("WO Priority Code").Orientation = xlRowField
    pvt.PivotFields("WO Sub Type").Orientation = xlRowField
    pvt.PivotFields("WO Reason Description").Orientation = xlRowField
    pvt.PivotFields("CCC Affected WO Fltr").Orientation = xlRowField
    pvt.PivotFields("WO Subject").Orientation = xlRowField
    pvt.PivotFields("RoleCode").Orientation = xlRowField
    pvt.PivotFields("User Name").Orientation = xlRowField
    pvt.PivotFields("Days In Role").Orientation = xlRowField
    pvt.PivotFields("True WO Status").Orientation = xlRowField
    pvt.PivotFields("Order_By_No").Orientation = xlRowField
    pvt.PivotFields("WO Init Date").Orientation = xlRowField
    pvt.PivotFields("PROC_DATE").Orientation = xlRowField
    pvt.PivotFields("Has Cost Info").Orientation = xlRowField

    ActiveSheet.PivotTables("PivotTable1").RepeatAllLabels xlRepeatLabels
    ActiveSheet.PivotTables("PivotTable1").PivotFields("WO"). _
        Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
        False, False)

    Selection.Copy
    
    MsgBox "Metrics Complete"
    
End Sub
 

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.
Sort by date Sort by votes
With the following code, you'll notice that I use the Array function to list pivot item names and pivot field names, but for brevity I've listed only the first two for each one. You'll need to add the remaining names to each of the Array functions. Better yet, create a named range for each one and then simply replace each Array function with their respective named range.. So, for example, you would replace...

Code: 
Array(...., ..., ...)

with

Code: 
Range("MyNamedRange")

Also, you'll notice that I've used the Option Explicit statement, and I've declared all my variables. Have a look at the following link to see why these are good things to do.

https://a4accounting.com.au/declaring-variables-in-excel-vba/

Here's the code (UNTESTED)...

Code: 
Option Explicit

Sub test()


    Dim pvt As PivotTable
    Dim pf As PivotField
    Dim pi As PivotItem
    Dim vMatchVal As Variant


    Set pvt = Sheets("SMMRY - WO BY DAYS IN ROLE").PivotTables("PivotTable1")
    
    With pvt
        .ColumnGrand = False
        .RowGrand = False
        .RowAxisLayout xlTabularRow
        .ClearTable
        'Filters
        With .PivotFields("CCC Affected WO Fltr")
            .ClearAllFilters
            .EnableMultiplePageItems = True
            .PivotItems("No").Visible = False
        End With
        With .PivotFields("GFLT")
            .ClearAllFilters
            .EnableMultiplePageItems = True
            .PivotItems("Powertrain").Visible = False
        End With
        With .PivotFields("WO Type")
            .ClearAllFilters
            .EnableMultiplePageItems = True
            For Each pi In .PivotItems
                vMatchVal = Application.Match(pi.Name, Array("AWO", "BMB"), 0) 'add other pivot item names accordingly
                If Not IsError(vMatchVal) Then
                    pi.Visible = False
                End If
            Next pi
        End With
        With .PivotFields("WO Sub Type")
            .ClearAllFilters
            .EnableMultiplePageItems = True
            For Each pi In .PivotItems
                vMatchVal = Application.Match(pi.Name, Array("01, * Accessory", "10, Asm Plant Process Chg"), 0) 'add other pivot item names accordingly
                If Not IsError(vMatchVal) Then
                    pi.Visible = False
                End If
            Next pi
        End With
        'Columns
        For Each pf In .PivotFields
            vMatchVal = Application.Match(pf.Name, Array("WO", "LEAD WO"), 0) 'add other pivot field names accordingly
            If Not IsError(vMatchVal) Then
                pf.Orientation = xlRowField
            End If
        Next pf
        'Formatting
        .RepeatAllLabels xlRepeatLabels
        .PivotFields("WO").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
    End With
    
    MsgBox "Metrics Complete"
    
End Sub

Hope this helps!
 
Upvote 0
Domenic said:
With the following code, you'll notice that I use the Array function to list pivot item names and pivot field names, but for brevity I've listed only the first two for each one. You'll need to add the remaining names to each of the Array functions. Better yet, create a named range for each one and then simply replace each Array function with their respective named range.. So, for example, you would replace...

Code: 
Array(...., ..., ...)

with

Code: 
Range("MyNamedRange")

Also, you'll notice that I've used the Option Explicit statement, and I've declared all my variables. Have a look at the following link to see why these are good things to do.

https://a4accounting.com.au/declaring-variables-in-excel-vba/

Here's the code (UNTESTED)...

Code: 
Option Explicit

Sub test()


    Dim pvt As PivotTable
    Dim pf As PivotField
    Dim pi As PivotItem
    Dim vMatchVal As Variant


    Set pvt = Sheets("SMMRY - WO BY DAYS IN ROLE").PivotTables("PivotTable1")
    
    With pvt
        .ColumnGrand = False
        .RowGrand = False
        .RowAxisLayout xlTabularRow
        .ClearTable
        'Filters
        With .PivotFields("CCC Affected WO Fltr")
            .ClearAllFilters
            .EnableMultiplePageItems = True
            .PivotItems("No").Visible = False
        End With
        With .PivotFields("GFLT")
            .ClearAllFilters
            .EnableMultiplePageItems = True
            .PivotItems("Powertrain").Visible = False
        End With
        With .PivotFields("WO Type")
            .ClearAllFilters
            .EnableMultiplePageItems = True
            For Each pi In .PivotItems
                vMatchVal = Application.Match(pi.Name, Array("AWO", "BMB"), 0) 'add other pivot item names accordingly
                If Not IsError(vMatchVal) Then
                    pi.Visible = False
                End If
            Next pi
        End With
        With .PivotFields("WO Sub Type")
            .ClearAllFilters
            .EnableMultiplePageItems = True
            For Each pi In .PivotItems
                vMatchVal = Application.Match(pi.Name, Array("01, * Accessory", "10, Asm Plant Process Chg"), 0) 'add other pivot item names accordingly
                If Not IsError(vMatchVal) Then
                    pi.Visible = False
                End If
            Next pi
        End With
        'Columns
        For Each pf In .PivotFields
            vMatchVal = Application.Match(pf.Name, Array("WO", "LEAD WO"), 0) 'add other pivot field names accordingly
            If Not IsError(vMatchVal) Then
                pf.Orientation = xlRowField
            End If
        Next pf
        'Formatting
        .RepeatAllLabels xlRepeatLabels
        .PivotFields("WO").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
    End With
    
    MsgBox "Metrics Complete"
    
End Sub

Hope this helps!
Click to expand...

Thank you this is very helpful. I think defining a range would be the best option since those fields will update every few months. Is it posuble to create a range in my personal notebook (usually always open, but hidden)? At the end of this I copy and paste the data from the pivot table info into a different workbook since the file is read only.
 
Upvote 0
To refer to a named range within a hidden workbook, try...

Code: 
vMatchVal = Application.Match(pi.Name, Workbooks("Book1.xlsm").Names("MyNamedRange").RefersToRange, 0)
 
Last edited:
Upvote 0
Domenic said:
You're very welcome!

Cheers!
Click to expand...

I am getting around to testing this and I am getting an error that says "subscrpit out of range"

Code: 
Set pvt = Sheets("SMMRY - WO BY DAYS IN ROLE").PivotTables("PivotTable1")

I have checked that the name of the sheet is correct and the pivot table is called PivotTable1 on that worksheet.
 
Last edited:
Upvote 0
Domenic said:
Did you check for extra spaces in the sheet name?
Click to expand...

That was the problem. Thank you.

Now the error is that the Array fields for Columns are not populating in the order that I list them in. They are showing in a different error every time I run the code. Any way to make the columns appear in the order that I list them in? This is that section of code:

Code: 
  'Columns
        For Each pf In .PivotFields
            vMatchVal = Application.Match(pf.Name, Array("WO", "LEAD WO", "Product Line", "YEAR", "Prgrms", "Engineering Region", "GFLT", "WO Subject", "WO Priority Code", "WO Sub Type", "WO Reason Description", "CCC Affected WO Fltr", "WO Subject", "RoleCode", "User Name", "Days In Role", "True WO Status", "Order_By_No", "WO Init Date", "PROC_DATE", "Has Cost Info"), 0)
            
            If Not IsError(vMatchVal) Then
                pf.Orientation = xlRowField
            End If
        Next pf
 
Upvote 0
Sorry, my mistake. First declare the following variables...

Code: 
    Dim vPivotFields As Variant
    Dim i As Long

Then try the following instead...

Code: 
    vPivotFields = Array("WO", "LEAD WO", "Product Line", "YEAR", "Prgrms", "Engineering Region", "GFLT", "WO Subject", "WO Priority Code", "WO Sub Type", "WO Reason Description", "CCC Affected WO Fltr", "WO Subject", "RoleCode", "User Name", "Days In Role", "True WO Status", "Order_By_No", "WO Init Date", "PROC_DATE", "Has Cost Info")    

    For i = LBound(vPivotFields) To UBound(vPivotFields)
        With .PivotFields(vPivotFields(i))
            .Orientation = xlRowField
            .Position = i + 1
        End With
    Next i
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Question Question
VBA Pivot Table
Replies
3
Views
2K
Domenic
D
M
  • Solved
Copy filtered pivot table data to new sheets instead of new workbooks
2
Replies
11
Views
2K
Martin sherk
M
C
  • Solved
VBA Pivot Table
Replies
2
Views
869
chaddres
C
E
  • Solved
Excel VBA macro that creates a pivot table works for one user but not another
Replies
5
Views
3K
Eagle72
E
larinda4
  • Solved
VBA Pivot Table: Adjusting Row and Column Numbers
Replies
4
Views
856
larinda4
larinda4

Forum statistics

Threads
1,224,823
Messages
6,181,178
Members
453,021
Latest member
Justyna P

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