trying to add filter to pivot using vba

Question

I am trying to run vba on Pivot Tables since I need to update like 50+ tables for my report which would only save time if I can do this using vba.

Using vba, I can copy results from pivot tables directly into cells of another sheet of the same workbook. I got stuck trying to add filters.

I was able to run the first part where I got my summary info and now I am trying to add a "Revised Territory" filter and I want to filter for "SE" then it just didn't do anything.

I used F8 to check and it looks like it just goes through without any error but did not add any filter and so I got the same info as my summary data.

My Code

Sub InsertPivotTable()

''''''''''''''''''
'''Pivot Set Up'''
''''''''''''''''''
'Declare Variables
Dim PSheet As Worksheet
Dim DSheet As Worksheet
Dim SSheet As Worksheet
Dim PCache As PivotCache
Dim PTable As PivotTable
Dim PRange As Range
Dim LastRow As Long
Dim LastCol As Long

'Insert a New Blank Worksheet
On Error Resume Next

Sheets.Add Before:=ActiveSheet
ActiveSheet.Name = "PivotTable"
Application.DisplayAlerts = True
Set PSheet = Worksheets("PivotTable")
Set DSheet = Worksheets("PIF Data")
Set SSheet = Worksheets("Summary")

'Define Data Range
LastRow = DSheet.Cells(Rows.Count, 1).End(xlUp).Row
LastCol = 76
Set PRange = DSheet.Cells(1, 1).Resize(LastRow, LastCol)

'''''''''
'Summary'
'''''''''
'Define Pivot Cache
Set PCache = ActiveWorkbook.PivotCaches.Create _
    (SourceType:=xlDatabase, SourceData:=PRange). _
    CreatePivotTable(TableDestination:=PSheet.Cells(3, 1), _
    TableName:="NB Summary")

'Insert Blank Pivot Table
Set PTable = PCache.CreatePivotTable _
    (TableDestination:=PSheet.Cells(1, 1), TableName:="NB Summary")
Dim Pvt As PivotTable
Set Pvt = Worksheets("PivotTable").PivotTables("NB Summary")

'Add fields to rows & values, re-name title of value
With Pvt
    .PivotFields("Policy Form").Orientation = xlColumnField
.PivotFields("Phone/Email").Orientation = xlRowField
    .AddDataField .PivotFields("Policy Number"), "Count of Policy Number", xlCount
End With

PSheet.Range("B5:B6").Copy
SSheet.Range("E6").PasteSpecial Paste:=xlPasteValues
PSheet.Range("C5:C6").Copy
SSheet.Range("G6").PasteSpecial Paste:=xlPasteValues

''''
'SE'
''''
With Pvt
    .ClearAllFilters
    .PivotFields("Revised Territory").PivotFilter.Add Type:=xlCaptionContains, Value1:="SE"
End With

PSheet.Range("B5:B6").Copy
SSheet.Range("E12").PasteSpecial Paste:=xlPasteValues
PSheet.Range("C5:C6").Copy
SSheet.Range("G12").PasteSpecial Paste:=xlPasteValues

'Delete PivotTable Sheet
Application.DisplayAlerts = False
Worksheets("PivotTable").Delete
Application.DisplayAlerts = True

End Sub

Remove the line 'on error resume next' so you can see where and what errors are occuring (that 'on error resume next' causes it to ignore) — RowanC
– RowanC, Commented Apr 5, 2018 at 8:54
@sc1324 Is there any reason why you don't simply use the PivotTable itself as the report? And it sounds like this is just one piece of your reporting "puzzle" given your comment below. If you give a little more context about what your end goal is up front, you might not need to ask as many followup questions. — jeffreyweir
– jeffreyweir, Commented Apr 5, 2018 at 21:28
Hi, sorry I didn't specify the requirements for this particular project and my intention was to try to do this on my own so that's why I didn't want to put a 3 page description in the body and not getting anything done and trying to get a free pass here. — sc1324
– sc1324, Commented Apr 6, 2018 at 14:41

Shai Rado · Accepted Answer · 2018-04-05 11:58:48Z

1

Try the code below, detailed explanations in the code's comments.

Modified Code

Option Explicit

Sub InsertPivotTable()

''''''''''''''''''
'''Pivot Set Up'''
''''''''''''''''''
'Declare Variables
Dim PSheet As Worksheet
Dim DSheet As Worksheet
Dim SSheet As Worksheet
Dim PCache As PivotCache
Dim PTable As PivotTable
Dim PFld As PivotField
Dim PItm As PivotItem
Dim PRange As Range
Dim LastRow As Long, LastCol As Long

' --- Check if there's already a sheet named "PivotTable" ---
On Error Resume Next
Set PSheet = ThisWorkbook.Sheets("PivotTable")
On Error GoTo 0
If PSheet Is Nothing Then ' there's no sheet named "PivotTable" >> create one
    Set PSheet = ThisWorkbook.Sheets.Add(Before:=ActiveSheet)
    PSheet.Name = "PivotTable"
End If

Application.DisplayAlerts = True

Set DSheet = Worksheets("PIF Data")
Set SSheet = Worksheets("Summary")

'Define Data Range
With DSheet
    LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    LastCol = 76 ' <-- you have 76 Colkumns of Data ??!
    Set PRange = .Cells(1, 1).Resize(LastRow, LastCol)
End With

'''''''''
'Summary'
'''''''''
' Set Pivot Cache object
Set PCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PRange.Address(False, False, xlA1, xlExternal))

' create a new Pivot Table in "PivotTable" sheet, start from Cell A1
Set PTable = PSheet.PivotTables.Add(PivotCache:=PCache, TableDestination:=PSheet.Range("A1"), TableName:="NB Summary")

' Add fields to rows & values, re-name title of value
With PTable
    .PivotFields("Policy Form").Orientation = xlColumnField
    .PivotFields("Phone/Email").Orientation = xlRowField
    .AddDataField .PivotFields("Policy Number"), "Count of Policy Number", xlCount
End With

PSheet.Range("B5:B6").Copy
SSheet.Range("E6").PasteSpecial Paste:=xlPasteValues
PSheet.Range("C5:C6").Copy
SSheet.Range("G6").PasteSpecial Paste:=xlPasteValues

''''
'SE'
''''
' ===== Filter PivotField "Revised Territory" section according to "SE" =====
With PTable
    .ClearAllFilters

    ' set PivotField "Revised Territory"
    Set PFld = .PivotFields("Revised Territory")

    With PFld
        .Orientation = xlPageField
        .Position = 1

        ' loop through PivotField "Revised Territory" pivot-items
        For Each PItm In .PivotItems
            If PItm.Caption = "SE" Then
                PItm.Visible = True
            Else
                PItm.Visible = False
            End If
        Next PItm
    End With
End With

PSheet.Range("B5:B6").Copy
SSheet.Range("E12").PasteSpecial Paste:=xlPasteValues
PSheet.Range("C5:C6").Copy
SSheet.Range("G12").PasteSpecial Paste:=xlPasteValues

'Delete PivotTable Sheet
Application.DisplayAlerts = False
PSheet.Delete
Application.DisplayAlerts = True

End Sub

answered Apr 5, 2018 at 11:58

Shai Rado

33.7k7 gold badges32 silver badges55 bronze badges

Sign up to request clarification or add additional context in comments.

4 Comments

sc1324 Over a year ago

Yes I have 76 columns of data. Sweet, your codes saved my day. Now I can continue. Stay tuned for more questions lol. Thank you.

jeffreyweir Over a year ago

Looping through PivotItems in a PivotField is slow...particularly if you haven't set the PivotTable .ManualUpdate property to TRUE, as the PivotTable refreshes after each and every pivotitem is changed. Given PivotFields("Revised Territory") is a PageField, there's no need to loop through it in any case, as you can simply use PFld.CurrentPage = "SE" and so avoid the loop altogether. I've written a fairly comprehensive blogpost on this at dailydoseofexcel.com/archives/2013/11/14/… that has more information about how to loop PivotItems efficiently

Shai Rado Over a year ago

@jeffreyweir I'm aware of this option, but i still prefers using this method. Also, define Slow, I used this option also for ~200 Pivot items , still the entire code ran, including some heavy copy>>paste in less than 0.5 seconds. I can live with that

jeffreyweir Over a year ago

For sure, 200 PivotItems is nothing. But without asking, who knows whether a PivotField has 200 or 200,000 items in it? As that post I linked to shows, if a Pivot has a non-trivial amount of say 20,000 items, looping the items, checking the status, and changing it will take upwards of four minutes. And in fact it will take much longer than that if you leave ManualUpdate set to FALSE.

Collectives™ on Stack Overflow

trying to add filter to pivot using vba

1 Answer 1

4 Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

4 Comments

Your Answer

Sign up or log in

Post as a guest

Related