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
 

Excel Facts

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December
Hi and Welcome to the Board,

Could you clarify why you are trying to AutoFilter that range?

How will you use that to apply a PivotTable filter(s)?
 
Upvote 0
Hi Jerry,

Basically, what I want is to create the Pivot, where the "Process Area" Field should select only 10 values out of all 70/80 values from teh base sheet. And also for the date range, which is there for the task Start column should show records those comes "after or equal to" the date for which I need to run this report.

Please let me know if you need any more clarification.
 
Upvote 0
I believe the specific cause of the error is that LastRow hasn't been declared or assigned.
Code:
Worksheets("Sheet2").Range("A8:CA8" & LastRow).AutoFilter

You probably meant that to be this after assigning LastRow a value...
Code:
Worksheets("Sheet2").Range("A8:CA" & LastRow).AutoFilter

Nonetheless, I don't think using an Autofilter is a good fit for this.

For the Task Start, since it is a RowField, you can use a Criteria-based Date Filter for the date ranges instead of using the manual (checkbox) filters.
This only works if all your values in the field are dates (no blanks or non-dates).

For filtering multiple items in your PageField(s) you could try applying the function shown in this thread...
Help tweaking vba to filter pivot based off range
 
Upvote 0
Hi Jerry,

I tried the way you have shown by assigning Last row a value, but got the same error. Anyway, let me try with the other link. Thanks.
 
Upvote 0
Hi Jerry,

Sorry to say that your doubt is right, as I faced difficulty indeed adapting those examples.

I kept the Function copied in a seperate module as I was not sure where to place it exactly. Finally I had to remove the "Private" to make it callable from my existing codes. Then I saw one more error message, this one says "Compile Error: Named Argument Not Found". It's showing this error highlighting "vItems".

I will wait for your help.

Thanks
 
Upvote 0
The functions could be placed in either the same module as your existing codes or in a separate module.
You are correct that if you put them in a separate module the key word should be chaned to Public.

Sounds like you were calling the function without including the vItems parameter.
Please post the calling code you were trying - it probably just needs a tweak.

I'd recommend you create a Sub for doing the PivotTable filtering that is separate from the code that creates the Pivot - at least for development and testing.
 
Upvote 0
Hi Jerry, I'm back.

Functions Ikept in a seperate module as follows:

Code:
Public Function Filter_PivotField(Pf As PivotField, _
        varItemList 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
        If vItems(0) = "(All)" Then
            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
    
    Set PT = Sheets("Lists").PivotTables("SamplePivot")
    
CleanUp:
    PT.Parent.ManualUpdate = False
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Function
[\code]


On the other hand the calling code which I've used is as follows:

[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
    
    
  
    ' 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
    

Set PT = Sheets("Sheet2").PivotTables("SamplePivot")
Filter_PivotField Pf:=PT.PivotFields("Process Area"), _
vItems:=Application.Transpose(Sheets("Lists").Range("I1:I3"))
  
  
    ' 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
[\code]

I've a seperate Tab "Lists" which has the data range for the filter "Process Area". Pivot is being created in Sheet2, and Sheet1 is having the main data source for pivot.
 
Upvote 0
This is the code actually I've used:

Code:
[B][COLOR=#ff0000]Dim Pf As PivotField
Dim PT As PivotTable
[/COLOR][/B]
[B][COLOR=#ff0000]Set PT = Sheets("Sheet2").PivotTables("SamplePivot")
Filter_PivotField Pf:=PT.PivotFields("Process Area"), _
vItems:=Application.Transpose(Sheets("Lists").Range("I1:I3"))

[/COLOR][/B]
 
Last edited:
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