VBA - Loop Pivot Table Filtering Extract - vba

Question

I have the below code which applies a filter to a Pivot Table, then specific data is copied from the PivotTable and the filters are removed.. The issue is, this one block of code is used 22 times, the sub is waaaay too long.
Here is the code I have with only ONE of the blocks:
Option Explicit
Sub FilterPivotTable()
Dim rLastCell As Range
Dim PvtTbl As PivotTable
Dim ws1 As Worksheet, ws2 As Worksheet
Dim LastRow1 As Long
Set ws1 = ActiveWorkbook.Sheets("PivotTable")
Set ws2 = ActiveWorkbook.Sheets("Summary")
Dim rowCount As Long
LastRow1 = ws1.Cells(Rows.Count, 1)
'Microsoft Windows
Application.ScreenUpdating = False
ws1.PivotTables("P1").ManualUpdate = True
ws1.PivotTables("P1").PivotFields(" Vulnerability Name").ClearAllFilters
'---------------Block Starts Here---------------
ws1.PivotTables("P1").PivotFields(" Vulnerability Name").PivotFilters. _
Add Type:=xlCaptionContains, Value1:="Microsoft Windows"
ws1.PivotTables("P1").ManualUpdate = False
Application.ScreenUpdating = True
With ws1.PivotTables(1).TableRange1
Set rLastCell = .Cells(.Rows.Count, .Columns.Count)
Set PvtTbl = Worksheets("PivotTable").PivotTables("P1")
rLastCell.Copy
With ws2
.Cells(LastRow1 + 2, 3).PasteSpecial xlPasteValues
.Range("$B$2").Value = "Microsoft Windows"
rowCount = PvtTbl.DataBodyRange.Rows.Count
.Range("$D$2") = rowCount - 1
End With
End With
ws1.PivotTables("P1").PivotFields(" Vulnerability Name").ClearAllFilters
'---------------Block Ends Here---------------
End Sub
This block of code is repeated 22 times throughout this sub, each time only changing the vulnerability name i.e. Changing 'Microsoft Windows' to 'Adobe' and then changing the Cell Reference for where the data is to be copied to the Summary Sheet.
I am hoping to rather have one block of code that loops through the vulnerability names instead of having 22 different blocks of code performing the same function.
This is what the Pivot Table Structure looks like:
The filter is done under the rows block and done on Vulnerability Name

Answer 1

This is a bit of a punt in the dark I'm afraid
Option Explicit
Sub FilterPivotTable()
Dim rLastCell As Range
Dim PvtTbl As PivotTable
Dim ws1 As Worksheet, ws2 As Worksheet
Set ws1 = ActiveWorkbook.Sheets("PivotTable")
Set ws2 = ActiveWorkbook.Sheets("Summary")
Dim rowCount As Long
Dim LastRow1 As Long
Dim pvtField As PivotField
Set PvtTbl = ws1.PivotTables("P1")
Application.ScreenUpdating = False
Set pvtField = PvtTbl.PivotFields(" Vulnerability Name") 'extend etc as required
Dim myArr()
myArr = Array("Microsoft Windows", "Adobe Reader", "Other")
'PvtTbl.ManualUpdate = False
Dim i As Long
For i = LBound(myArr) To UBound(myArr)
pvtField.ClearAllFilters
pvtField.PivotFilters. _
Add Type:=xlCaptionContains, Value1:=myArr(i)
With ws1.PivotTables(1).TableRange1
Set rLastCell = .Cells(.Rows.count, .Columns.count) 'grand total?
End With
With ws2
LastRow1 = ws2.Cells(ws2.Rows.count, 3).End(xlUp).row
rLastCell.Copy
.Cells(LastRow1 + 1, 3).PasteSpecial xlPasteValues
.Cells(LastRow1 + 1, 2).Value = myArr(i)
rowCount = PvtTbl.DataBodyRange.Rows.count
.Cells(LastRow1 + 1, 4) = rowCount - 1
End With
Next i
Application.ScreenUpdating = True
'PvtTbl.ManualUpdate = False
End Sub