VBA - Move all Row Fields to Report Filter, Regardless of Field Name

Goose306

Board Regular
Joined
Sep 26, 2014
Messages
52
Hi,

I'm building a macro right now that reads some filters a pivot table based on data entered in another master workbook. This file has to work with multiple (10+) different pivot tables, which are generated daily, and all of which have different Pivot Fields available.

I've gotten to where it does the desired filtering, but I've hit a block. I want the macro to move all of the existing Row Fields the pivot table opens with and move them to the Page Field (Report Filter). The names of these Row Fields varies greatly pivot by pivot, so I can't name each one, but instead want VBA to select all Row Fields and move them to Page Field.

I've tried several different options, but I can't quite get it. I'm relatively familiar with VBA, but this has been my first foray into dealing with Pivot Tables, and unfortunately I haven't been able to find much advanced functionality doing searches. Here's the existing code (with some names redacted due to sensitivity):

Code:
    Sub Report_Filter()
   
'Sets report filters in Pivot Tables based on set criteria range
    
'assume failure
    'On Error Resume Next 'Commented out while test
    
    Dim AP As Worksheet
        Set AP = ThisWorkbook.Worksheets("Audit Parameters")
    
    'if statements are required for date dims due to needing to reformat as string and then CDate to match reporting, otherwise it throws errors on blank
    If AP.Cells(9, 4) <> "" Then
        Dim str1 As String
            str1 = AP.Cells(9, 4).Text
        Dim st_date As Date
            st_date = CDate(str1)
    End If
    If AP.Cells(10, 4) <> "" Then
        Dim str2 As String
            str2 = AP.Cells(10, 4).Text
        Dim end_date As Date
            end_date = CDate(str2)
    End If
    
    Dim str3 As String
        str3 = AP.Cells(5, 4).Text
    Dim str4 As String
        str4 = AP.Cells(6, 4).Text
    Dim str5 As String
        str5 = AP.Cells(7, 4).Text
    Dim str6 As String
        str6 = AP.Cells(8, 4).Text
    Dim PT As PivotTable
        Set PT = ActiveCell.PivotTable 'this sets the active cell as the pivot table in question, as more automation occurs a better solution will be needed. Reports have different pivot table names, causing issues
    Dim PI As PivotItem
    Dim PIS As PivotItems
    Dim PF As PivotField
    Dim PFS As PivotFields


'Turn of automatic updates for moar speed
    Application.ScreenUpdating = False
    PT.ManualUpdate = True
    
'handle dates
    If AP.Cells(9, 4) <> "" And AP.Cells(10, 4) <> "" Then
        For Each PI In PT.PFS("Date").PIS
            If DateValue(PI.Name) < st_date Or DateValue(PI.Name) > end_date Then
                PI.Visible = False
            Else
                PI.Visible = True
            End If
        Next PI
    End If
    
'handle redacted1
    If AP.Cells(5, 4) <> "" Then
        For Each PI In PT.PFS("redacted1").PIS
            If PI.Value <> str3 Then
                PI.Visible = False
            Else
                PI.Visible = True
            End If
        Next PI
    End If
    
'handle redacted2
    If AP.Cells(6, 4) <> "" Then
        For Each PI In PT.PFS("redacted2").PIS
            If PI.Value <> str4 Then
                PI.Visible = False
            Else
                PI.Visible = True
            End If
        Next PI
    End If


'handle redacted3
    If AP.Cells(7, 4) <> "" Then
        For Each PI In PT.PFS("redacted3").PIS
            If PI.Value <> str5 Then
                PI.Visible = False
            Else
                PI.Visible = True
            End If
        Next PI
    End If


'handle redacted4
    If AP.Cells(8, 4) <> "" Then
        For Each PI In PT.PFS("redacted4").PIS
            If PI.Value <> str6 Then
                PI.Visible = False
            Else
                PI.Visible = True
            End If
        Next PI
    End If


[B]    With PT.PFS Like "*"[/B]
[B]        .Orientation = xlPageField[/B]
[B]    End With[/B]
    
'Turn automatic updates back on
    PT.ManualUpdate = False
    Application.ScreenUpdating = True


'On Error GoTo 0


End Sub

I bolded the particular part I'm having trouble on. If anyone has any suggestions, please help!
 

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.

Forum statistics

Threads
1,214,599
Messages
6,120,453
Members
448,967
Latest member
grijken

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
Back
Top