VBA to filter pivot column based off values from textbox

[darthbane]

Hello,
I would like some help with creating a macro that will filter one pivot field (column B) from my pivot table based on what the users enter in cell A4. The user can enter multiple values separated by commas to only show the rows they want to see. As the data will be 1000 rows - i would like a quick way to have it filtered down to just the specific rows that of are interest.

for example :

project number	$ (MM)	time (days)
aa-1	10	30
aa-2	5	80
bb-1	7	90
bb-2	8	240

<tbody>
</tbody>

The user can input aa-1,bb-1 into cell A4, to have the pivot filtered to show just those two rows

thanks in advance!

 

[JustynaMK]

Hi darthbane,

Try the following code:

Sub PivotFilter()
    Dim pvtTable            As PivotTable
    Dim pvtItem             As PivotItem
    Dim varFilters          As Variant


    With ActiveSheet
        Set pvtTable = .PivotTables("[COLOR=#ff0000]PivotTable1[/COLOR]")
        varFilters = Split(.Range("A4").Value, ",")
    End With
    
    pvtTable.ClearAllFilters
    
    With pvtTable.PivotFields("project number")
        For Each pvtItem In .PivotItems
            pvtItem.Visible = IsNumeric(Application.Match(pvtItem.Value, varFilters, 0))
        Next pvtItem
    End With
End Sub

Change the name of your Pivot Table (red font) if necessary. Let me know if this solution works for you.

 

[darthbane]

Hi JustynaMK,

yes! this does work. However it is very slow. The VBA takes a good 6-7 minutes to run. Is there any way this can be done quicker? I was hoping for it to be almost instant.

Thank you for the help!!

 

[JustynaMK]

Glad it works!

Hopefully it's just a matter of disabling Calculations... please try the following code:

Sub PivotFilter()
    Dim pvtTable            As PivotTable
    Dim pvtItem             As PivotItem
    Dim varFilters          As Variant


    Application.Calculation = xlCalculationManual


    With ActiveSheet
        Set pvtTable = .PivotTables("PivotTable1")
        varFilters = Split(.Range("A4").Value, ",")
    End With
    
    pvtTable.ClearAllFilters
    
    With pvtTable.PivotFields("project number")
        For Each pvtItem In .PivotItems
            pvtItem.Visible = IsNumeric(Application.Match(pvtItem.Value, varFilters, 0))
        Next pvtItem
    End With
    
    Application.Calculation = xlCalculationAutomatic
End Sub

 

[darthbane]

unfortunately it did not solve the problem, the time it takes to execute still seems unchanged..

 

[JustynaMK]

Hi darthbane,

Unfortunately I couldn't recreate your issue on my side. I created over 1000 rows of exemplary data for my Pivot Table, with 1000 different project numbers, and it still fully processes the code under 10 seconds. Is there any chance you could share the file so that I can check what is happening?

 

[darthbane]

Hi darthbane,

Unfortunately I couldn't recreate your issue on my side. I created over 1000 rows of exemplary data for my Pivot Table, with 1000 different project numbers, and it still fully processes the code under 10 seconds. Is there any chance you could share the file so that I can check what is happening?

Hi,

I am not able to see a way to add attachements on this forum. Here is a test copy uploaded to google drive.
https://drive.google.com/file/d/1vUiER-ct478wvB3wA-22pYn3fo-1m0Qy/view?usp=sharing

Thanks again, I appreciate you looking into this!

 

[JustynaMK]

Hi darthbane,

Thanks for sharing the file. I just run your code on my side ("Sheet1") and it took me exactly 15 seconds to fully process it. Did you attach the whole (complete) file?

Alternatively, you can add "Debug.Print Time" to your code and see which part takes the longest to run. You need to have VBA Immediate Window (Alt+F11 -> Ctrl+G) open in order to see the results.

Sorry, cannot think of any other solution!

Sub PivotFilter()
    Dim pvtTable            As PivotTable
    Dim pvtItem             As PivotItem
    Dim varFilters          As Variant
    
[COLOR=#ff0000]    Debug.Print Time[/COLOR]


    Application.Calculation = xlCalculationManual


    With ActiveSheet
        Set pvtTable = .PivotTables("PivotTable25")
        varFilters = Split(.Range("A1").Value, ",")
    End With
    
    pvtTable.ClearAllFilters
    
[COLOR=#ff0000]    Debug.Print Time[/COLOR]
    
    With pvtTable.PivotFields("Plan ID")
        For Each pvtItem In .PivotItems
            pvtItem.Visible = IsNumeric(Application.Match(pvtItem.Value, varFilters, 0))
        Next pvtItem
    End With
    
    Application.Calculation = xlCalculationAutomatic
    
[COLOR=#ff0000]    Debug.Print Time[/COLOR]
End Sub

 

[darthbane]

Thanks JustynaMK.
I tried running the VBA code again and it worked within 15 seconds!! Not sure why it was taking soo long before it may have been due to having a large amount of excel worksheets open at once..
Anyways you are awesome! thanks again

 

[JustynaMK]

awesome news! Take care & good luck.