VBA Pivot item filter using selection

Bablu

Board Regular
Joined
Dec 9, 2008
Messages
129
Hi All,

I need some assistance tweaking the below Pivot table macro.

First, I would like to be able to select the Pivot field, instead of having it within the macro. So once the code executed, I would prefer that using an input box, I should be able to select the Pivot field, in my case the filed is called "Trans Type".
Secondly, for the Array, I would like to be able to select a range of cells (again preferably using an input box to select, for example, I1:I6).

Once the macro is excuted, it should be able to filter by the field and item which is selected.

Now the macro below works very well, all I need is to be able incorporate the selection feature.

Highlighted in red are the two piece I need help changing.

Option Explicit

Sub FilterPivot()
Dim pt As PivotTable
Dim pf As PivotField
Dim pi As PivotItem
Dim i As Long
Dim vItem As Variant
Dim Accounts As Variant

' ActiveSheet.PivotTables(1)

Set pt = ActiveSheet.PivotTables(1)

Set pf = pt.PivotFields("Trans Type")
Accounts = Array("A: Due from Brokers", "A: Other Assets",)


pt.ManualUpdate = True 'Stops PivotTable from refreshing after each PivotItem is changed

With pf

'At least one item must remain visible in the PivotTable at all times, so make the first
'item visible, and at the end of the routine, check if it actually *should* be visible
.PivotItems(1).Visible = True

'Hide any other items that aren't already hidden.
'Note that it is far quicker to check the status than to change it.
' So only hide each item if it isn't already hidden
For i = 2 To .PivotItems.Count
If .PivotItems(i).Visible Then .PivotItems(i).Visible = False
Next i

'Make the PivotItems of interest visible
On Error Resume Next 'In case one of the items isn't found
For Each vItem In vCountries
.PivotItems(vItem).Visible = True
Next vItem
On Error GoTo 0

'Hide the first PivotItem, unless it is one of the countries of interest
On Error Resume Next
If InStr(UCase(Join(vCountries, "|")), UCase(.PivotItems(1))) = 0 Then .PivotItems(1).Visible = False
If Err.Number <> 0 Then
.ClearAllFilters
MsgBox Title:="No Items Found", Prompt:="None of the desired items was found in the Pivot, so I have cleared the filter"
End If
On Error GoTo 0

End With

pt.ManualUpdate = False

End Sub

Thanks!
 

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.

Forum statistics

Threads
1,143,689
Messages
5,720,310
Members
422,275
Latest member
Maria95

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
Top