VB Macro to Select/Change Pivot Table Filter

[mtskv5]

This is my first post, so I would first like to say that all the information I have found on this board has been extremely helpful. Thank you.

The issue:

I have a workbook that gets data from a text file, that data then populates a pivot table. The pivot table has one filter critiera (portfolio). One the filter is selected, the data populates an output tab with various formulas, values, extra. That output gets copied and pasted the various tabs within the workbook. Go back to pivot table and select different filter, rinse and repeat for 168 critiera (portfolios)

I currently have macros for all the steps in this process except selecting the pivot table filter critiera. I only need to select the filter critiera one at a time (no multiple values).

I am not a programmer, I have a minimumlistic scope when it comes to vba, however my non-vba excel knowledge is expansive. Thank you for your assistance.

-Matt

 

[mtskv5]

Thanks for getting back Keewhan

1 - Does the destination range have to be chosen by the user? Is it a fixed sheet / range that it goes to depending on the Pivot Item selected? You could build this logic into the code instead of having a range selection?

The destination must be chosen by the user. The range of the paste is contengent upon the Pivot Item. The reason I need it to be an user input is because each month the Pivot Items will change and so will the destinations.

2 - Would it be easier to have a list of the Pivot Items at the start of the code which you could select from before the code is executed?

Each pivot item must be pasted to the appropriate place, therefore going through the entire list is more ideal than selecting all the Pivot Items at the start of the code.

Hope this makes since, I could send you the sheet if that would help.

 

[keewhan]

OK...the reason your rRange Input Box wasnt quite working is because you have only referenced a range.

You then need to find the address of the range, and the worksheet that the selected range is on.

Have a go with the changed code below. I don't think you need to jump to the Line1 code as you do not want it to exit the sub, only select the Sheet called Filter Table to allow the loop to continue...I find simplification where possible is always best!

Also your code for the copy does not support PasteValues....it will only do a brutal copy / paste. You have to select the range, or use Application.Goto as I have done, first to use the PasteSpecial functionality

       Sheets("Output").Range("A2:G29").Copy _
       Destination:=rRange, Paste:=xlPasteValues

So...see how these changes work..to tidy it up and stop an error if you click OK on your input box with no value i have added turned off DisplayAlerts at the beginning and back on at the end

Sub Loop_PivotItems()

Dim rRange As Range

With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
End With

'to select the sheet with the pivot table
    Sheets("Filter Table").Select

'Loop through every PivotItem in the PageField (Filter) of the Pivot Table
    For Each PivotItem In ActiveSheet.PivotTables(1).PageFields(1).PivotItems

'Select the PivotItem
        ActiveSheet.PivotTables(1).PageFields(1).CurrentPage = PivotItem.Value

'Do whatever you need here....
        Set rRange = Application.InputBox(Prompt:= _
               "Please select where you would like to paste " + PivotItem, _
                   Title:="Copy and Paste Utility", Type:=8)
                    
        If rRange Is Nothing Then
             Sheets("Filter Table").Select
        Else
            Sheets("Output").Range("A2:G29").Copy
                Application.Goto (Sheets(rRange.Worksheet.Name).Range(rRange.Address))
                     Selection.PasteSpecial Paste:=xlValues
                         Application.CutCopyMode = False
                             Sheets("Filter Table").Select
       End If
Next

With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
End With

End Sub

 

[mtskv5]

Thank you sooooo much Keewhan! It works. This is great, should really save a bunch of time.

 

[keewhan]

excellent glad to be able to help!

 

[JoeyStern]

Hello Folks,

I've been following along and tried to use this for my own purposes. I want to have my spreadsheet make a bunch of files based on the filtering in the pivot. (only one at a time, only "company").

Here is what I made from your code, can you tell me where I have made my mistake?

Application.ScreenUpdating = False
  Application.DisplayAlerts = False
 'to select the sheet with the pivot table
    Sheets("PIVOT").Select
'Loop through every PivotItem in the PageField (Filter) of the Pivot Table
  For Each PivotItem In ActiveSheet.PivotTables("PivotTable3").PivotFields("Company").PivotItems
'Select the PivotItem
    AActiveSheet.PivotTables("PivotTable3").PivotFields("Company") = PivotItem.Value
'Do whatever you need here....
    Sheets("PIVOT").Copy Before:=Sheets(1)
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("B5:G5").Select
    Application.CutCopyMode = False
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Selection.ClearContents
    ActiveCell.FormulaR1C1 = "Campaign Breakdown"
    Range("B6").Select
    Sheets("Campaign Performance 2010-08").Select
    Rows("2:6").Select
    Selection.Copy
    Sheets("PIVOT (2)").Select
    Rows("2:2").Select
    Selection.Insert Shift:=xlDown
    Range("B8").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("F3").Select
    ActiveSheet.Paste
    Columns("F:F").EntireColumn.AutoFit
    Range("F5").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "9/1/2010"
    Range("F6").Select
    ActiveCell.FormulaR1C1 = "9/30/2010"
    Range("F7").Select
    ActiveSheet.Next.Select
    ActiveSheet.Next.Select
    ActiveSheet.Next.Select
    ActiveSheet.Next.Select
    ActiveSheet.Previous.Select
    Range("B8:H9").Select
    Selection.Copy
    ActiveSheet.Previous.Select
    ActiveSheet.Previous.Select
    ActiveSheet.Previous.Select
    Range("B10:G10").Select
    ActiveSheet.Paste
    Columns("H:H").EntireColumn.AutoFit
    Range("H12").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=RC[-1]/RC[-2]"
    Range("H12").Select
    Selection.Style = "Percent"
    Selection.NumberFormat = "0.0%"
    Selection.NumberFormat = "0.00%"
    ActiveSheet.Next.Select
    ActiveSheet.Next.Select
    ActiveSheet.Next.Select
    ActiveSheet.Next.Select
    Range("A1").Select
    ActiveSheet.Previous.Select
    Range("B10:H10").Select
    Selection.Copy
    Sheets("PIVOT (2)").Select
    Range("B12").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("B8").Select
    Selection.ClearContents
    Range("A11").Select
    Selection.ClearContents
    Range("A1").Select
    Selection.ClearContents
    Range("A8").Select
    Selection.ClearContents
    Sheets("PIVOT (2)").Select
    Sheets("PIVOT (2)").Name = "Performance Report"
    Range("A27").Select
    Sheets("Performance Report").Select
    Sheets("Performance Report").Move
     ActiveWorkbook.SaveAs Filename:=Range("F3").Value & "2010-09.xls", FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
    ActiveWindow.Close
Next
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

 

[Euphony010]

'Turn off screen updating
Application.ScreenUpdating = False
'Store the sheet with the Pivot Table
Pivot = ActiveSheet.Name
'Loop through every PivotItem in the PageField (Filter) of the Pivot Table
For Each PivotItem In ActiveSheet.PivotTables(1).PageFields("End User Name").PivotItems
'Select the PivotItem
ActiveSheet.PivotTables(1).PageFields("End User Name").CurrentPage = PivotItem

Hi Keewhan - I'm running into an error with the above script.

I have a set of 1000+ customers that I want to separate into 1000 separate files. I've got the file creation automated and everything is well on that end.

Here is the line that the error happens:

ActiveSheet.PivotTables(1).PageFields("End User Name").CurrentPage = PivotItem

Error:
Run time error '5':
Invalid procedure call or argument

When I left the MsgBox originally, it worked, scrolling through every customer. But I can't get it to select the next item down. I feel like the error line is not actually selecting the next available customer in the filter field "End User Name".

The sheet name is "Pivot", and the filter is "End User Name", with the drop down located in cell B1.

I appreciate any help!

Thanks,
Thomas

 

[keewhan]

Hi Thomas

If you are running some code once you select the item in the filter to create a new sheet you probably need to tell the macro to return to the sheet with the pivot table in it for it to be able to continue

e.g.
Sheets("Pivot").Select
ActiveSheet.PivotTables(1).PageFields("End User Name").CurrentPage = PivotItem

If you are creating a new workbook with your code you will need to return to the window with the pivot table in it...something like this

Windows("Pivot Book").Activate
Sheets("Pivot").Select
ActiveSheet.PivotTables(1).PageFields("End User Name").CurrentPage = PivotItem
k

 

[Euphony010]

Sub Loop_PivotItems()
'Turn off screen updating
Application.ScreenUpdating = False
'Store the sheet with the Pivot Table
Pivot = ActiveSheet.Name
'Loop through every PivotItem in the PageField (End User Company) of the Pivot Table
'Select the PivotItem
For Each PivotItem In ActiveSheet.PivotTables(1).PageFields("End User Name").PivotItems
'Do whatever you need here....
MsgBox (PivotItem.Value)

'Return to sheet with the Pivot Table
Sheets(Pivot).Select

Next
'Turn on screen updating
Application.ScreenUpdating = True
End Sub

I've simplified for example here.

When I run that, I get the msgbox with each end user. I believe it is only reading down the list rather than actually unselecting the filter and reselecting the next value down the list. I need it to reselect the next value so that the pivot table populates the new information.

Thanks for your quick response!

Thomas

 

[keewhan]

did you pick up the code from the original example to select the pivot item?


'Select the PivotItem

ActiveSheet.PivotTables(1).PageFields(1).CurrentPage = PivotItem.Value

k

 

[Euphony010]

Ok, I've recopied your original code and editted for my sheet:

Sub Loop_PivotItems()
'Turn off screen updating
Application.ScreenUpdating = False
'Store the sheet with the Pivot Table
Pivot = ActiveSheet.Name
'Loop through every PivotItem in the PageField ("End User Name") of the Pivot Table
For Each PivotItem In ActiveSheet.PivotTables(1).PageFields("End User Name").PivotItems
'Select the PivotItem
ActiveSheet.PivotTables(1).PageFields(1).CurrentPage = PivotItem.Value
'Do whatever you need here....
MsgBox (PivotItem.Value)
 
'Return to sheet with the Pivot Table
Sheets(Pivot).Select
 
Next
'Turn on screen updating
Application.ScreenUpdating = True
End Sub

I also tried it with this line:

ActiveSheet.PivotTables(1).PageFields("End User Name").CurrentPage = PivotItem.Value

The Sheet name is "Pivot"
The filter value is "End User Name"

Currently, this code will show the first end users name as a message, then error on this line:

ActiveSheet.PivotTables(1).PageFields(1).CurrentPage = PivotItem.Value

The error is: Runtime Error "5", Invalid Call or Argument

Thanks so much for your help!