Need Help In Applying Filter in Pivot Created through Macro

allExcell

Board Regular
Joined
Jan 8, 2013
Messages
71
Hi All,

I'm new to this forum, but not too new as a follower. I've started learning VBA for my own sake and tips and tricks that I've seen in your forum was actually too helpful.


This time I need a help. I've a work sheet containing base data and the other sheet with a Pivot created based on the Base data. Here, I've created one Macro which is generating the Pivot. Now the Problem is that there are few fileds which needs filters to be placed. As for example one Date Filter which will take the date from another sheet from the same workbook and will populate the Pivot as "after or equal to" the date provided, let's say in Sheet3, Cell B2. And, one more filter is needed at the 1st Field, which will select only 10 out of some 80 odd values, this I've tried creating an array and tried to call the Values in a List given in a seperate Sheet from the same workbook, unfortunately the code is throwing some error, which I'm sure because of my poor knowledge in VBA (but surely improving). The Code I've highlighted with Red/Bold is actually throwing the error which says, "Run Time Error '1004'. AutoFilter method of Range Class Failer".




The codes are given below for your ref:


Code:
 Sub MakePivotTable_Tab1_Ovrdue_Qual()
    Dim pt As PivotTable
    Dim strField As String
    Dim WSD As Worksheet
    Set WSD = Worksheets("Sheet1")
    Dim PTOutput As Worksheet
    Set PTOutput = Worksheets("Sheet2")
    Dim PTCache As PivotCache
    Dim PRange As Range
    Dim PI As PivotItem
    Dim Pf As PivotField
    
    Dim Arr As Variant
    Dim i As Integer
    
           
    ' Find the last row with data
    Dim finalRow As Long
    finalRow = WSD.Cells(Application.Rows.Count, 1).End(xlUp).Row
    
    ' Find the last column with data
    Dim finalCol As Long
    finalCol = WSD.Cells(1, Application.Columns.Count).End(xlToLeft).Column
    
    ' Find the range of the data
    Set PRange = WSD.Cells(1, 1).Resize(finalRow, finalCol)
    Set PTCache = ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=PRange)
    
    ' Create the pivot table
    Set pt = PTCache.CreatePivotTable(TableDestination:=PTOutput.Cells(7, 1), TableName:="SamplePivot")
    
    ' Define the layout of the pivot table
    ' Set update to manual to avoid recomputation while laying out
    pt.ManualUpdate = True
    
    ' Set up the Pivot fields
 With pt
    .PivotFields("Process Area").Orientation = xlRowField
    .PivotFields("Unique Role ID").Orientation = xlRowField
    .PivotFields("Projects Names").Orientation = xlRowField
    .PivotFields("Role and Sub Role").Orientation = xlRowField
    .PivotFields("Employment Type").Orientation = xlRowField
    .PivotFields("Requested Name").Orientation = xlRowField
    .PivotFields("Location Role").Orientation = xlRowField
    .PivotFields("Role Description").Orientation = xlRowField
    .PivotFields("Project Description").Orientation = xlRowField
    .PivotFields("Request Status").Orientation = xlRowField
    .PivotFields("Resource Name").Orientation = xlRowField
    .PivotFields("Booking Condition").Orientation = xlRowField
    .PivotFields("Request Manager").Orientation = xlRowField
    .PivotFields("Task Start").Orientation = xlRowField
    .PivotFields("Task Finish").Orientation = xlRowField
    .PivotFields("DOP Resource Status").Orientation = xlPageField
    .PivotFields("Week Commencing").Orientation = xlColumnField
End With

'This sets each field in ascending order. It applies this even to fields
'     that are not currently in the PivotTable.
For Each Pf In pt.PivotFields
    Pf.AutoSort xlAscending, Pf.Name
    Pf.Subtotals(1) = True
    Pf.Subtotals(1) = False
Next Pf

'This changes the formatting of any field that appears in the Values area
For Each Pf In pt.DataFields
    Pf.Function = xlSum
    Pf.NumberFormat = "0.0"
Next Pf
 
'This section applies Classic PivotTable settings
'     and turns off the Contextual Tooltips and the Expand/Collapse buttons
With pt
    .InGridDropZones = True
    .RowAxisLayout xlTabularRow
    .TableStyle2 = ""
    .DisplayContextTooltips = False
    .ShowDrillIndicators = False
End With

'This ensures that only data that still exists in the data
'     that drives the PivotTable
'     will appear in the PivotTable dropdown lists
pt.PivotCache.MissingItemsLimit = xlMissingItemsNone
 
'Applying Filter at "DOP Resource Status"
With pt.PivotFields("DOP Resource Status").CurrentPage = "(All)"
     pt.PivotFields("DOP Resource Status").PivotItems("Other - please provide details in comments field").Visible = False
     pt.PivotFields("DOP Resource Status").PivotItems("(blank)").Visible = False
     pt.PivotFields("DOP Resource Status").EnableMultiplePageItems = True
End With
    
      [B][COLOR=#ff0000]Arr = WorksheetFunction.Transpose(Worksheets("Lists").Range("I1:I3").Value)
    For i = LBound(Arr) To UBound(Arr)
        Arr(i) = CStr(Arr(i))
    Next i
    Worksheets("Sheet2").Range("A8:CA8" & LastRow).AutoFilter Field:=1, Criteria1:=Arr, Operator:=xlFilterValues
[/COLOR][/B]  
  
  
    ' Setting up the data field
   With pt.PivotFields("Assignment Work")
        .Orientation = xlDataField
        .Position = 1
        .Caption = "Sum of Assignment Work"
        .Function = xlSum
    End With
                
   ' calc the pivot table
    pt.ManualUpdate = False
    
     
End Sub
 
Hi Jerry,

I'm back. I've created different set of Lists for different Sheets/Tabs in a seperate Tab "Lists". This will define different Filter criteria for 5 different Tabs. So now the question is, can we customize the code in such a way, so that every time I run the Macro to create "Pivot" it gets created in all 5 Tabs and while creating it should call different Functions for 5 different Tabs respectively.


Earlier I thought of writing seperate code for Seperate Macros to be created, but that will again be a laborious job and will not look good either (as writing too many lines of similar codes into different modules). Then I thought, if I can modify the code in such a way, so that every time it creates Pivot into each sheet (named differently), it should call the function specific to that particular sheet.


Please let me know if it's doable and then how to proceed with?

Thanks
 
Upvote 0

Excel Facts

Return population for a City
If you have a list of cities in A2:A100, use Data, Geography. Then =A2.Population and copy down.
Hi Jerry,

Thanks for sharing the post. It was already there in my mind since long and frankly speaking this is what I'm still doing for the same report so far. I've created Template with PT in use, and applied different filters there. But, here I faced few problems a couple of times.

Sometimes, I've seen my Template to crash, leaving me with no option other than to re-create the same...and this is always a painful tasks if you are handling a huge chunk of data with lot of variations in filters and all. Secondly, I've seen PT to store some Duplicate values in the filter which again causes confusion among the stakeholders as PT is not deleting the old cache. And thirdly, as PT created manually has some human interventions involved (particularly, in ase where we are applying filters with too many similar entries...) stakeholders doubts on the authenticity of the report considering the human error part. Based on these issues, I took the decission to automate the entire process. Pleasse let me know if I'm too wrong and my reasons are not enough for me to think this way.

Thanks
 
Last edited:
Upvote 0
There's nothing wrong with creating the Pivots with VBA, and I'll be glad to help with some code if you want to go that route.

You could use this as a general process to develop the code...
1. Make Sub code to create one Pivot on one sheet using explict names for the Sheets, PivotTables, Fields and List Ranges. (you already have much of this code).
2. Convert the Sub to a Function and replace the explict names with Parameter Variables.
3. Write a Sub that calls the Function and creates the one Pivot on one Sheet.
4. Expand that Sub to call the Function 5 different times with 5 sets of Parameters to create all 5 Pivots on 5 Sheets.
 
Upvote 0
Hi Jerry,

The code is now looking like this:


Code:
Sub Create_MultiplePivots()
    Dim PT As PivotTable
    Dim strField As String
    Dim WSD As Worksheet
    Set WSD = Worksheets("Base Data")
    Dim PTOutput As Worksheet
    Set PTOutput = Worksheets("Qualified OverDue Roles")
    
    
    Dim PTCache As PivotCache
    Dim PRange As Range
    Dim PI As PivotItem
    Dim Pf As PivotField
    
    
  
    ' Find the last row with data
    Dim finalRow As Long
    finalRow = WSD.Cells(Application.Rows.Count, 1).End(xlUp).Row
    
    ' Find the last column with data
    Dim finalCol As Long
    finalCol = WSD.Cells(1, Application.Columns.Count).End(xlToLeft).Column
    
    ' Find the range of the data
    Set PRange = WSD.Cells(1, 1).Resize(finalRow, finalCol)
    Set PTCache = ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=PRange)
    
    ' Create the pivot table
    Set PT = PTCache.CreatePivotTable(TableDestination:=PTOutput.Cells(7, 1), TableName:="SamplePivot")
    ' Define the layout of the pivot table
    ' Set update to manual to avoid recomputation while laying out
    PT.ManualUpdate = True
    
     
 
 With PT
    .PivotFields("Process Area").Orientation = xlRowField
    .PivotFields("Unique Role ID").Orientation = xlRowField
    .PivotFields("Projects Names").Orientation = xlRowField
    .PivotFields("Role and Sub Role").Orientation = xlRowField
    .PivotFields("Employment Type").Orientation = xlRowField
    .PivotFields("Requested Name").Orientation = xlRowField
    .PivotFields("Location Role").Orientation = xlRowField
    .PivotFields("Role Description").Orientation = xlRowField
    .PivotFields("Project Description").Orientation = xlRowField
    .PivotFields("Request Status").Orientation = xlRowField
    .PivotFields("Resource Name").Orientation = xlRowField
    .PivotFields("Booking Condition").Orientation = xlRowField
    .PivotFields("Request Manager").Orientation = xlRowField
    .PivotFields("Task Start").Orientation = xlRowField
    .PivotFields("Task Finish").Orientation = xlRowField
    .PivotFields("DOP Resource Status").Orientation = xlPageField
    .PivotFields("Week Commencing").Orientation = xlColumnField
End With

'This sets each field in ascending order. It applies this even to fields
'     that are not currently in the PivotTable.
For Each Pf In PT.PivotFields
    Pf.AutoSort xlAscending, Pf.Name
    Pf.Subtotals(1) = True
    Pf.Subtotals(1) = False
Next Pf
'This command changes the formatting of any field that appears in the Values area
For Each Pf In PT.DataFields
    Pf.Function = xlSum
    Pf.NumberFormat = "0.0"
Next Pf
 
'This section applies Classic PivotTable settings
'     and turns off the Contextual Tooltips and the Expand/Collapse buttons
With PT
    .InGridDropZones = True
    .RowAxisLayout xlTabularRow
    .TableStyle2 = ""
    .DisplayContextTooltips = False
    .ShowDrillIndicators = False
End With
'This ensures that only data that still exists in the data
'     that drives the PivotTable
'     will appear in the PivotTable dropdown lists
PT.PivotCache.MissingItemsLimit = xlMissingItemsNone
 
'Applying Filter at "DOP Resource Status"
With PT.PivotFields("DOP Resource Status").CurrentPage = "(All)"
     PT.PivotFields("DOP Resource Status").PivotItems("Other - please provide details in comments field").Visible = False
     PT.PivotFields("DOP Resource Status").PivotItems("(blank)").Visible = False
     PT.PivotFields("DOP Resource Status").EnableMultiplePageItems = True
End With
    
    ' Setting up the data field
   With PT.PivotFields("Assignment Work")
        .Orientation = xlDataField
        .Position = 1
        .Caption = "Sum of Assignment Work"
        .Function = xlSum
    End With
      
Set PT = Sheets("Qualified OverDue Roles").PivotTables("SamplePivot")
Filter_PivotField Pf:=PT.PivotFields("Process Area"), _
vItems:=Application.Transpose(Sheets("Lists").Range("I3:I6"))

Set vItems = Nothing
 Filter_PivotField Pf:=PT.PivotFields("Booking Condition"), _
vItems:=Application.Transpose(Sheets("Lists").Range("J3:J4"))
  
Set vItems = Nothing
 Filter_PivotField Pf:=PT.PivotFields("Employment Type"), _
vItems:=Application.Transpose(Sheets("Lists").Range("K3:K13"))

Set vItems = Nothing
 Filter_PivotField Pf:=PT.PivotFields("Request Status"), _
vItems:=Application.Transpose(Sheets("Lists").Range("L3:L6"))

    
          
 ' calc the pivot table
PT.ManualUpdate = False
    
End Sub



...and I got confused at Step#2. This code is actually calling the function1 (Filter_PivotField) but each time it will call a different function!!
 
Upvote 0
Here is a start at Step #2- converting the sub from one with specific names to variable references.

I've done the obvious and easy ones first - like the Sheet Names and PivotTable Name..

Code:
Sub Create_MultiplePivots()
    Call Create_Single_Pivot( _
        wsData:=Sheets("Base Data"), _
        wsOutput:=Sheets("Qualified OverDue Roles"), _
        sTableName:="SamplePivot", _
        sReportFilter:="DOP Resource Status" _
    ) 'end Call
    
End Sub

Function Create_Single_Pivot(wsData As Worksheet, wsOutput As Worksheet, sTableName As String, _
        sReportFilter As String)
    
    Dim PT As PivotTable
    Dim PTCache As PivotCache
    Dim PRange As Range
    Dim PI As PivotItem
    Dim Pf As PivotField

    ' Find the range of the data
    Set PRange = wsData.Cells(1, 1).CurrentRegion
    Set PTCache = ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=PRange)
    
    ' Create the pivot table
    Set PT = PTCache.CreatePivotTable(TableDestination:=wsOutput.Cells(7, 1), TableName:=sTableName)
    ' Define the layout of the pivot table
    ' Set update to manual to avoid recomputation while laying out
    PT.ManualUpdate = True
    
    With PT
        .PivotFields("Process Area").Orientation = xlRowField
        .PivotFields("Unique Role ID").Orientation = xlRowField
        .PivotFields("Projects Names").Orientation = xlRowField
        .PivotFields("Role and Sub Role").Orientation = xlRowField
        .PivotFields("Employment Type").Orientation = xlRowField
        .PivotFields("Requested Name").Orientation = xlRowField
        .PivotFields("Location Role").Orientation = xlRowField
        .PivotFields("Role Description").Orientation = xlRowField
        .PivotFields("Project Description").Orientation = xlRowField
        .PivotFields("Request Status").Orientation = xlRowField
        .PivotFields("Resource Name").Orientation = xlRowField
        .PivotFields("Booking Condition").Orientation = xlRowField
        .PivotFields("Request Manager").Orientation = xlRowField
        .PivotFields("Task Start").Orientation = xlRowField
        .PivotFields("Task Finish").Orientation = xlRowField
        .PivotFields("DOP Resource Status").Orientation = xlPageField
        .PivotFields("Week Commencing").Orientation = xlColumnField
    End With
    
    ' Setting up the data field
    With PT.PivotFields("Assignment Work")
        .Orientation = xlDataField
        .Position = 1
        .Caption = "Sum of Assignment Work"
        .Function = xlSum
    End With
    
    'This sets each field in ascending order. It applies this even to fields
    '     that are not currently in the PivotTable.
    For Each Pf In PT.PivotFields
        Pf.AutoSort xlAscending, Pf.Name
        Pf.Subtotals(1) = True
        Pf.Subtotals(1) = False
    Next Pf
    
    'This command changes the formatting of any field that appears in the Values area
    For Each Pf In PT.DataFields
        Pf.Function = xlSum
        Pf.NumberFormat = "0.0"
    Next Pf
     
    'This section applies Classic PivotTable settings
    '     and turns off the Contextual Tooltips and the Expand/Collapse buttons
    With PT
        .InGridDropZones = True
        .RowAxisLayout xlTabularRow
        .TableStyle2 = ""
        .DisplayContextTooltips = False
        .ShowDrillIndicators = False
    End With

    'This ensures that only data that still exists in the data
    '     that drives the PivotTable
    '     will appear in the PivotTable dropdown lists
    PT.PivotCache.MissingItemsLimit = xlMissingItemsNone
 
    'Applying Filter at "DOP Resource Status"
    With PT.PivotFields("DOP Resource Status")
        .EnableMultiplePageItems = True
        .CurrentPage = "(All)"
        .PivotItems("Other - please provide details in comments field").Visible = False
        .PivotItems("(blank)").Visible = False
    End With
         
    Filter_PivotField Pf:=PT.PivotFields("Process Area"), _
        vItems:=Application.Transpose(Sheets("Lists").Range("I3:I6"))

    Filter_PivotField Pf:=PT.PivotFields("Booking Condition"), _
        vItems:=Application.Transpose(Sheets("Lists").Range("J3:J4"))
  
    Filter_PivotField Pf:=PT.PivotFields("Employment Type"), _
        vItems:=Application.Transpose(Sheets("Lists").Range("K3:K13"))

    Filter_PivotField Pf:=PT.PivotFields("Request Status"), _
        vItems:=Application.Transpose(Sheets("Lists").Range("L3:L6"))
        
 ' calc the pivot table
    PT.ManualUpdate = False
    
End Function

You'll need to think about which things are to be the same in all Pivots, and which could be different.
For example, the current code places the PivotTable at Cell A7 of each specified sheet...

Code:
Set PT = PTCache.CreatePivotTable(TableDestination:=wsOutput.Cells(7, 1), TableName:=sTableName)

If that works okay for you, then keep that in the Function. If you want to be able to place the Pivot at different locations on different sheets, that will need to be changed to a variable parameter.

Taken to its extreme, the function call could have so many parameters and options that it doesn't provide the benefit of reducing duplication of code and becomes harder to use than completely separate Subs. So you'll need to decide what really needs to be different.

The code will get a bit more complex presuming that you might have varying numbers of Row Fields, Column Fields.
One way to handle that would be to pass all the Row Fields as an Array of PivotFields in the order the Fields are to appear.

Try experimenting with this and then let me know your thoughts on what remaining parts will be the same in all Pivots, and which need to become parameters.
 
Last edited:
Upvote 0
Hi Jerry,

You are verry true. I've decided on what to keep inside Function and what not to. As for example, below mentioned 3 filters would varry with each Pivot.

Code:
Filter_PivotField Pf:=PT.PivotFields("Process Area"), _
        vItems:=Application.Transpose(Sheets("Lists").Range("I3:I6"))

    Filter_PivotField Pf:=PT.PivotFields("Booking Condition"), _
        vItems:=Application.Transpose(Sheets("Lists").Range("J3:J4"))
  
    Filter_PivotField Pf:=PT.PivotFields("Employment Type"), _
        vItems:=Application.Transpose(Sheets("Lists").Range("K3:K13"))

    Filter_PivotField Pf:=PT.PivotFields("Request Status"), _
        vItems:=Application.Transpose(Sheets("Lists").Range("L3:L6"))

In the above code, the range will keep on changing for each Pivot Item filters, as for example the PArea filter in next sheet should populate the filter value from, say Range("M3:M6") and so on.

Rest of the things are fine.

a.) Each pivot PivotTable is created at Cell A7 of each specified sheet.
b.) sReportFilter:="DOP Resource Status" is a common filter in each Pivot.
c.) Each Pivot will be created on a Seperate Sheet.
d.) Number of Rows/Columns/Fields are same for all pivots.
 
Upvote 0
Hi Jerry,

Some more updates.
Based on different Filter Conditions applicable to specific sheets, I've created 5 different Filter Functions, like the one I already have. I've kept them in seperate Modules.
Beside this I've written a Sub to call the Function and create the one Pivot on one Sheet.
Next Step (#4) seems a bit tricky, I'm trying.
 
Upvote 0

Forum statistics

Threads
1,224,595
Messages
6,179,798
Members
452,943
Latest member
Newbie4296

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