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
 
Nice progress! :)

I didn't know you were trying that so I went ahead with one approach.
See if you can weave together this code plus the filtering code that you have been developing.

Code:
Sub Create_Pivot_1()
    Dim vRowFields() As Variant
    Dim PT As PivotTable

    
   '---Create the Pivot here using the call to a generalized function
    vRowFields = Array("Process Area", "Unique Role ID", "Projects Names",  _
        "Role and Sub Role", "Employment Type", _
        "Process Area", "Requested Name", "Location Role", "Role Description", "Project Description", _
        "Request Status", "Resource Name", "Booking Condition", "Request Manager", _
        "Task Start", "Task Finish")

 
    Set PT = Create_Single_Pivot( _
        wsData:=Sheets("Base Data"), _
        wsOutput:=Sheets("Qualified OverDue Roles"), _
        sTableName:="SamplePivot", _
        vPageFields:=Array("DOP Resource Status"), _
        vRowFields:=vRowFields, _
        vColumnFields:=Array("Week Commencing"), _
        vDataFields:=Array("Assignment Work") _
    ) 'end Call


    '---customize the Pivot here with additional steps that are harder to generalize
    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"))


End Sub

Code:
Function Create_Single_Pivot(wsData As Worksheet, wsOutput As Worksheet, sTableName As String, _
        Optional vRowFields As Variant = Null, Optional vPageFields As Variant = Null, _
        Optional vColumnFields As Variant = Null, Optional vDataFields As Variant = Null) As PivotTable
    
    Dim PT As PivotTable
    Dim PTCache As PivotCache
    Dim PRange As Range
    Dim PI As PivotItem
    Dim Pf As PivotField
    Dim i As Long

    ' 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)
    
    With PT
        ' Define the layout of the pivot table
        ' Set update to manual to avoid recomputation while laying out
        .ManualUpdate = True
        
        '--PageFields
        If IsArray(vPageFields) Then
            For i = LBound(vPageFields) To UBound(vPageFields)
                .PivotFields(vPageFields(i)).Orientation = xlPageField
            Next i
        End If
    
        '--RowFields
        If IsArray(vRowFields) Then
            For i = LBound(vRowFields) To UBound(vRowFields)
                .PivotFields(vRowFields(i)).Orientation = xlRowField
            Next i
        End If
     
        '--ColumnFields
        If IsArray(vColumnFields) Then
            For i = LBound(vColumnFields) To UBound(vColumnFields)
                .PivotFields(vColumnFields(i)).Orientation = xlColumnField
            Next i
        End If
        
        '--DataFields
        If IsArray(vDataFields) Then
            For i = LBound(vDataFields) To UBound(vDataFields)
                .PivotFields(vDataFields(i)).Orientation = xlDataField
            Next i
        End If
    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
        .PivotCache.MissingItemsLimit = xlMissingItemsNone
        .InGridDropZones = True
        .RowAxisLayout xlTabularRow
        .TableStyle2 = ""
        .DisplayContextTooltips = False
        .ShowDrillIndicators = False
        .ManualUpdate = False
    End With
    Set Create_Single_Pivot = PT
End Function

Finally, the idea would be to have one "Main" sub to create all 5 Pivots...
Code:
Sub Main_Create_Pivots()
    Application.ScreenUpdating = False
    
    Create_Pivot_1
    Create_Pivot_2
    Create_Pivot_3
    Create_Pivot_4
    Create_Pivot_5
    
    Application.ScreenUpdating = True
End Sub
 
Last edited:
Upvote 0

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.
Hi Jerry,

I've a question. As per the process you have shown, do you think we would be creating 5 different subs like "Create_Pivot_1()"?
Moreover, the codes given below will keep on changing, asfor each Sheet filters will get populated by values from different set of ranges;

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

so, we may need to define the code in such a way so that once each Pivots are created, each of them should call their respective Functions seperately. Say, Function Filter1,.....Function Filter5 are their for Create_Pivot_1(),......Create_Pivot_5().

As per my understanding the above mentioned code is specific to "Create_Pivot_1()". If thsi is so, am I suppose to code seperately for all 5 pivots, or can we use the single code for Pivot creation to create all 5 pivots? Let's say, if we can make the Output WS as Variable, which will Change everytime with , say as for example Sheet1, SHeet2, Sheet3, ...Sheet5, etc.

Can we use the approach shown here, in the below link or something similar to that so that Pivots get created into different sheets like I said.
Working With Excel Worksheets In VBA Macro Code

Please let me know if my understanding of your initiative is not correct. This is now really going above my head.
:banghead:
 
Upvote 0
Yes, my suggestion was that you create 5 separarte procedures... Create_Pivot_1, Create_Pivot_2..., Create_Pivot_5, then call them all from a Main sub.

The result is effectively the same as creating one big Main sub that has the same code that these 5 separate procedures would have.
My preference is to break these up for ease of maintenance (easier to find the parts to be edited).
 
Upvote 0
Hi Jerry, Great to see you again.

So, now I'm trying to insert the Date filter code into it. I'd written a code earlier which used to work fine with manually created pivots. But, the same is not working even after a few changes I made in the existing code to customize it with the new macro code.

Please guide me into this.

The code is given below for your ref:
Code:
Sub Apply_Date_Filter()
Dim StartDate As Date

'takes the Date values from the sheet
StartDate = Sheets("Lists").Range("B40").Value

 
'format dates fields as dd mmm yy
Sheets("Base Data").Select
    Range("I:J").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.NumberFormat = "dd/mm/yy"

' applying date filter in "Qualified OverDue Roles"
Sheets("Qualified OverDue Roles").Select
      ActiveSheet.PivotTables("SamplePivot").PivotFields("Task Start"). _
      ClearAllFilters
      ActiveSheet.PivotTables("SamplePivot").PivotFields("Task Start").PivotFilters. _
      Add Type:=xlBefore, Value1:=StartDate

Sheets("Control").Select
End Sub

As per my understanding the problem is with the "Pivot Name", though I'm not too sure how to resolve this.
 
Upvote 0
Hi again allExcel, :)

You didn't describe the result you were getting when it doesn't work. Is there an error message or is it just not changing the filters?

Changing the date format of Range(I:J) won't impact the pivot filter by date- that reads the dates stored in the Pivot Cache, not what's displayed on in the PivotTable.

The macro recorder can be really helpful in these situations, because it can help you see what date format Excel is expecting for the filter by start date.

With the macro recorder on, try manually doing the steps to filter by start date.
If you aren't able to spot and fix the problem, then please post that recorded code.
 
Upvote 0
Hi Jerry,

I doubt Macro recored will not help me here...as Date Filter is disabled, I'm not able to customize it.
The error which I was getting was "Run-Time Error '1004'/Application-defined or object-defined error" and it's selecting below 2 lines:

Code:
ActiveSheet.PivotTables("SamplePivot").PivotFields("Task Start").PivotFilters. _
      Add Type:=xlBefore, Value1:=StartDate
 
Last edited:
Upvote 0
If the date filter is greyed out, it typically means that you have at least one non-date item in that field.
Clean up your source date to eliminate blanks, spaces or text, then refresh your pivot table and see if the Date filter option becomes enabled.

If you don't clean up the data to be all dates, then PivotFilter won't work using VBA either.
 
Upvote 0
Jerry, I think the problem could be something else. I'm using the same data for other pivot reports where Pivots are manually created and the date code is applying date filter correctly. Moreover, I can convert all dates into Numbers, that means there is no text value. The pivot on which I want to apply this date filter is created through Macro. Any suggestion?
 
Upvote 0
Are there any blanks in your data source for that field? For example, if you have 995 rows of data and you reference 1000 rows as your pivot table data source, those last 5 blank rows will prevent the date filters from being used.

If that isn't the problem, I'd be glad to take a look at your workbook to see if I can find another reason.
 
Upvote 0

Forum statistics

Threads
1,224,597
Messages
6,179,808
Members
452,944
Latest member
2558216095

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