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
 
The error is coming from the declaration in the Function.

In the example code it was...
Code:
Public Function Filter_PivotField(ptField As PivotField, _
        vItems As Variant)


You've modified it to this...
Code:
Public Function Filter_PivotField(Pf As PivotField, _
 varItemList As Variant)

There's no problem with changing the variables; but they need to match in the function Call.
 
Upvote 0

Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.
Thanks Jerry,

Hi Jerry,

Thanks a lot for poiunting out the mistake. I've corrected it now.

But unfortunately I'm still getting some error message as "Subscript out of range/Run-Time error '9'", for the below code:

It could be too disturbing to you, but I'm still trying to learn the Macro and had no idea of coding.....so troubling you all.


Code:
Public Function Filter_PivotField(Pf As PivotField, _
vItems As Variant)
Dim PT As PivotTable

'---Filters the PivotField to make stored vItems Visible
Dim sItem As String, bTemp As Boolean, i As Long
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
If Not (IsArray(vItems)) Then
vItems = Array(vItems)
End If
With Pf
.Parent.ManualUpdate = True
If .Orientation = xlPageField Then .EnableMultiplePageItems = True
[COLOR=#ff0000][B]If vItems(0) = "(All)" Then
[/B][/COLOR]For i = 1 To .PivotItems.Count
If Not .PivotItems(i).Visible Then _
.PivotItems(i).Visible = True
Next i
Else
For i = LBound(vItems) To UBound(vItems)
bTemp = Not (IsError(.PivotItems(vItems(i)).Visible))
If bTemp Then
sItem = .PivotItems(vItems(i))
Exit For
End If
Next i
If sItem = "" Then
MsgBox "None of filter list items found."
GoTo CleanUp
End If
.PivotItems(sItem).Visible = True
For i = 1 To .PivotItems.Count
If IsError(Application.Match(.PivotItems(i), _
vItems, 0)) = .PivotItems(i).Visible Then
.PivotItems(i).Visible = Not (.PivotItems(i).Visible)
End If
Next i
End If
End With



CleanUp:
PT.Parent.ManualUpdate = False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Function
 
Upvote 0
My mistake. The function was originally written for an array with a lower bound of 0.
When you pass the vItems array from a range, it has a lower bound of 1 which causes the Subscript error.

Replace this statement...
Code:
If vItems(0) = "(All)" Then

With this ... which should work regardless of the lower bound.
Code:
If vItems(LBound(vItems)) = "(All)" Then


No worries about troubling me...I enjoy helping people like you who want to learn and I've received much help from others. :)
 
Upvote 0
Jerry, I'm really very sorry but one more error came towards the end:"Run-Time Error 91: Object Variable or With Block Variablenot set"

Code:
CleanUp:
[B][COLOR=#ff0000]PT.Parent.ManualUpdate = False
[/COLOR][/B]Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
 
Upvote 0
You teaked the example code a bit and didn't get that reference quite right.

It should be...
Code:
pf.Parent.ManualUpdate = False

What's happening there is that we want to reset the PivotTable's ManualUpdate property to false; however the parameters passed to the function don't include the PivotTable- just one of it's PivotFields.

The object variable PT that you assigned in the calling function has no scope (or meaning) in this function.
It looks like you tried to add a PT object to in the function to overcome that, but that isn't assigned to any object.

Alternatively you could use...
Code:
Dim PT as PivotTable
Set PT=pf.Parent
PT.ManualUpdate = False

However the first code example is more concise.
 
Upvote 0
Thanks a lot Jerry, all is well now. Code is running smoothly. Now I've a few questions:

1.) Can I use this code to define few other filters as well? I mean, I need to define few more filters likewise. If I re-use the same code for multiple times defining seperate range each time will that be fine?
2.) Can I use the same function to define multiple filters, by defining seperate range for it ?
3.) As I really had no prior coding knowledge, can you please help me find a portal or something, where from I can learn VBA/Macro coding?

For rest of the things like date filter, I will start working now.
Thanks a lot for your valuable time and effort.
-Deep.
 
Upvote 0
1.) Can I use this code to define few other filters as well? I mean, I need to define few more filters likewise. If I re-use the same code for multiple times defining seperate range each time will that be fine?
2.) Can I use the same function to define multiple filters, by defining seperate range for it ?
You can call the function multiple time with different parameters for the pivotfield and/or range of items to be visible. One of the benefits of having it as a separate procedure is that it can be called many times with different parameters which avoids duplication of coding making it easier to maintain.


3.) As I really had no prior coding knowledge, can you please help me find a portal or something, where from I can learn VBA/Macro coding?

You have done very well at finding and adapting code examples and that's a good start.
Everyone learns differently, so it's hard to recommend a single source.

hiker95 maintains a list of resources that he occasionally posts. Here is a recent update.
http://www.mrexcel.com/forum/excel-questions/668168-automation.html#post3311093
 
Last edited:
Upvote 0
Hi Jerry,

I made some progress and now using the same function I can apply filters on multiple Columns, though "Date Filter" thing I've not tried yet. Hopefully I will try this weekend.

In between, I will ask for some more input from you. Let me explain you the purpose of this initiative first.
I want to create a report that will have 5 diff pivots in 5 diff worksheets, in the same workbook. I want to create all 5 pivots using the same code, probably in an array, if that is possible. Then I would like to call 5 diff functions (one for each tab) to populate the different set of filters in them. Here I need some idea from you, on how to go about it.
All 5 Pivots are having different set of filters with nothing common between them.

Thanks in advance, have a great day.

:bow:
 
Last edited:
Upvote 0
How do you want to trigger the calling of the 5 different Macros? (let's use that term for what you called your 5 different functions, to not get confused with calling our Function procedures). Will you use a command button or an event, such as the user changing the value in a cell?

You could take the Sub and Function Procedures that will be common to all 5 Macros and place them in a standard code module.
Then depending on how you want to trigger the calling of the Macros, your calling Subs might be in the Worksheet code module or a separate Standard code module.

I'm not sure if that addresses the topic of your last question - please clarify if you were looking for something more specific.
 
Upvote 0

Forum statistics

Threads
1,224,595
Messages
6,179,799
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