ChangeAllPivotHeaders

[Rowland Hamilton]

Here is the code:
<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>

[COLOR=black][COLOR=black]Sub ChangeAllPivotHeaders()<o:p></o:p>[/COLOR]
[COLOR=black]Dim SPgField As String<o:p></o:p>[/COLOR]
[COLOR=black]'must keep cursor on page field<o:p></o:p>[/COLOR]
[COLOR=black]SPgField1 = Selection<o:p></o:p>[/COLOR]
[COLOR=black]Dim Pt As PivotTable<o:p></o:p>[/COLOR]
[COLOR=black]Dim Wsht As Worksheet<o:p></o:p>[/COLOR]
[COLOR=black]On Error Resume Next<o:p></o:p>[/COLOR]
[COLOR=black]For Each Wsht In ThisWorkbook.Worksheets<o:p></o:p>[/COLOR]
[COLOR=black]For Each Pt In Wsht.PivotTables<o:p></o:p>[/COLOR]
[COLOR=black]Pt.PageFields(1).CurrentPage = SPgField1<o:p></o:p>[/COLOR]
[COLOR=black]Next Pt<o:p></o:p>[/COLOR]
[COLOR=black]Next Wsht[/COLOR]
 
[COLOR=black]End Sub[/COLOR]
[/COLOR]

<o></o>
This macro will update all pivot table page fields in a workbook to match the changes made to one pivot table. However, it will update all page fields with the value of the last cell selected before running it, no matter if it is the desired page field, a blank cell outside of the pivot table, or any other cell. How can I add a restriction and a message that will require and prompt the user to keep the desired page field highlighted before running the macro to update all page fields? If possible allow any pivot table page field to be a valid selection, but if necessary, make it the first pivot. (Note - I have only one page field per pivot, and 32 pivots).

Perhaps a forumula like this one I used in another context can be applied (Can't figure out how to modify this for my purposes):

[COLOR=blue][COLOR=black]If Intersect(ActiveCell, Range("$F$8:$F$22")) Is Nothing Then[/COLOR]
[COLOR=black]  Range("F8:F22").Select[/COLOR]
[COLOR=black]  MsgBox "Please select a cell between F8 and F22"[/COLOR]
[COLOR=black]Else[/COLOR]
[/COLOR]

Thank you, Rowland

 

[Rowland Hamilton]

Update multiple pivot table page fields

Need Help. My workbook has 32 pivot tables across 13 worksheets, each with the same single page field. When I update the selection on any page field, keep the cell selected, then run this macro, all pivot tables in the workbook will update to match this selection, which is the desired result:

Sub ChangeAllPivotHeaders1()
Dim SPgField As String
'must keep cursor on page field
SPgField1 = Selection
Dim pt As PivotTable<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" /><o:p></o:p>
Dim Wsht As Worksheet
On Error Resume Next
For Each Wsht In ThisWorkbook.Worksheets
For Each pt In Wsht.PivotTables<o:p></o:p>
pt.PageFields(1).CurrentPage = SPgField1
Next pt
Next Wsht
<o:p> </o:p>
End Sub

However, if I select the wrong cell, like a blank cell, then run the macro, all page fields will update to blank and overwrite the option in the page selection that existed before. I can reverse this by typing the slection in a cell and running the macro again, but that is not ideal.

The following code from egghead requires the user to keep a page field selected and provides a message prompt to let you know that, but I did not actually get the macro to update any pivot tables and it may need to be modified to cycle through all worksheets in the workbook:

Sub ChangeAllPivotHeaders2()
<o:p> </o:p>
Dim pt As PivotTable, pf As PivotField
Dim pfrange As Range
For Each pt In ActiveSheet.PivotTables<o:p></o:p>
 For Each pf In pt.PageFields
  If pfrange Is Nothing Then
   Set pfrange = pf.DataRange
  Else
   Set pfrange = <?xml:namespace prefix = st1 ns = "urn:schemas-microsoft-com:office:smarttags" /><st1:place w:st="on">Union</st1:place>(pfrange, pf.DataRange)
  End If
 Next
Next
If Intersect(ActiveCell, pfrange) Is Nothing Then
 MsgBox "Please select a page cell from the range " & _
   pfrange.Address, vbOKOnly, "Page Field Not Selected"
End If
<o:p> </o:p>
End Sub

How can I get the best of both worlds, the effectiveness of the first code but still require that a page field is selected before allowing the macro to continue? - Thank you, Rowland

 

[Rowland Hamilton]

Re: Update multiple pivot table page fields

Help? Anyone know how to fix this?

The second code was only a snippet, I discovered, so it was not intended to work alone. However, I still do not know how to combine it with the previous code. Since the previous code is not at all restrictive on the cell selection used to update the pivot table page fields, The egghead guy got back to me with a totally new Code.

Sub SetAllPageFields()
  Dim pt As PivotTable, pf As PivotField, ws As Worksheet
  Dim pfrange As Range, pi As PivotItem
  For Each pt In ActiveSheet.PivotTables
    For Each pf In pt.PageFields
      If pfrange Is Nothing Then
        Set pfrange = pf.DataRange
      Else
        Set pfrange = Union(pfrange, pf.DataRange)
      End If
    Next
  Next
  If Intersect(ActiveCell, pfrange) Is Nothing Then
    MsgBox "Please select a page cell from the range " & _
      pfrange.Address, vbOKOnly, "Page Field Not Selected"
    Exit Sub
  End If
  For Each ws In Worksheets
    For Each pt In ws.PivotTables
      For Each pi In pt.PageFields(1).PivotItems
        If pi.Value = ActiveCell.Value Then
          pi.Parent.CurrentPage = ActiveCell.Value
        End If
      Next
    Next
  Next
End Sub

Pros: It updates all pivot tables across all worksheets and will only update the pivot tables if a pivot table page field is selected.

Cons: (1) So far, it keeps giving me a MS Visual Basic error message "400" after completing the job. IT doesn't seem to cause problems but I don't know what it means. (2) It doesn't update any of the other pivot tables when I select (All) in the page field.

I would like the option of using this code, with corrections, or the original "Sub ChangeAllPivotHeaders" code, modified to include the restriction that you must select a page field. - Thank you, Rowland

 

[Rowland Hamilton]

RE: Update multiple pivot table page fields

So, did anyone know how to fix Sub ChangeAllPivotHeaders() to require that a pivot table page field is selected before completing the macro?

Anyway, egghead did fix the new code, it works now to update all pivots, require a page field is selected, allow for (All) to be selected in the page field, and not generate an error message:

Sub SetAllPageFields()
  Dim pt As PivotTable, pf As PivotField, ws As Worksheet
  Dim pfrange As Range, pi As PivotItem
  On Error GoTo ErrorCatch
  For Each pt In ActiveSheet.PivotTables
    For Each pf In pt.PageFields
      If pfrange Is Nothing Then
        Set pfrange = pf.DataRange
      Else
        Set pfrange = Union(pfrange, pf.DataRange)
      End If
    Next
  Next
  If Intersect(ActiveCell, pfrange) Is Nothing Then
    MsgBox "Please select a page cell from the range " & _
      pfrange.Address, vbOKOnly, "Page Field Not Selected"
    Exit Sub
  End If
  For Each ws In Worksheets
    For Each pt In ws.PivotTables
      If pt.PageFields.Count = 0 Then ' next pt
      ElseIf ActiveCell.Value = "(All)" Then
        pt.PageFields(1).CurrentPage = ActiveCell.Value
      Else
        For Each pi In pt.PageFields(1).PivotItems
          If pi.Value = ActiveCell.Value Then
            pi.Parent.CurrentPage = ActiveCell.Value
          End If
        Next
      End If
    Next
  Next
  Exit Sub
ErrorCatch:
  MsgBox Err.Description
End Sub

Thank you - Rowland