VBA code to select multiple pivot tables

Memanja15

New Member
Joined
Aug 16, 2019
Messages
2
Hi all.

I'm hoping somebody can help please.

I've recorded a macro for one of my pivot tables, but I would like this recording to be applied to 3 other pivot tables in the same sheet.

At the moment, my code only references a range (A1:J14) and not the pivot table (PivotTable5) - can anybody help please? Code pasted below:

Sub Macro3()
'
' Macro3 Macro
'


'
ActiveCell.Offset(-1, -2).Range("A1:J14").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ThemeColor = 1
.TintAndShade = -4.99893185216834E-02
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ThemeColor = 1
.TintAndShade = -4.99893185216834E-02
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ThemeColor = 1
.TintAndShade = -4.99893185216834E-02
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ThemeColor = 1
.TintAndShade = -4.99893185216834E-02
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ThemeColor = 1
.TintAndShade = -4.99893185216834E-02
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ThemeColor = 1
.TintAndShade = -4.99893185216834E-02
.Weight = xlThin
End With
With Selection
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
ActiveCell.Offset(0, 2).Columns("A:A").EntireColumn.Select
Selection.Font.Bold = True
ActiveCell.Offset(0, 3).Columns("A:E").EntireColumn.Select
With Selection
.HorizontalAlignment = xlCenter
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
ActiveSheet.PivotTables("PivotTable5").PivotSelect "'Policy #1 '", _
xlDataAndLabel, True
End Sub
 

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.
Try this

You must have, in all tables, a field called: "Policy #1 " note: after 1 has a blank

Code:
Sub select_multiple_pivot_tables()
  Dim pt As PivotTable
  For Each pt In ActiveSheet.PivotTables
    pt.PivotSelect "'Policy [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL]  '", xlDataAndLabel, True
    With Range(pt.TableRange1.Address)
      .Borders.LineStyle = xlContinuous
      .Borders.ThemeColor = 1
      .Borders.TintAndShade = -4.99893185216834E-02
      .Borders.Weight = xlThin
      .WrapText = True
      .Orientation = 0
      .AddIndent = False
      .VerticalAlignment = xlCenter
      .IndentLevel = 0
      .ShrinkToFit = False
      .ReadingOrder = xlContext
      .MergeCells = False
      .Columns(1).Font.Bold = True
    End With
  Next
End Sub
 
Upvote 0
Try this

You must have, in all tables, a field called: "Policy #1 " note: after 1 has a blank

Code:
Sub select_multiple_pivot_tables()
  Dim pt As PivotTable
  For Each pt In ActiveSheet.PivotTables
    pt.PivotSelect "'Policy [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1"]#1[/URL]  '", xlDataAndLabel, True
    With Range(pt.TableRange1.Address)
      .Borders.LineStyle = xlContinuous
      .Borders.ThemeColor = 1
      .Borders.TintAndShade = -4.99893185216834E-02
      .Borders.Weight = xlThin
      .WrapText = True
      .Orientation = 0
      .AddIndent = False
      .VerticalAlignment = xlCenter
      .IndentLevel = 0
      .ShrinkToFit = False
      .ReadingOrder = xlContext
      .MergeCells = False
      .Columns(1).Font.Bold = True
    End With
  Next
End Sub

Hi thank you for this. Where do I enter Policy 1? Is this just a column heading?
 
Upvote 0
Hi thank you for this. Where do I enter Policy 1? Is this just a column heading?


I do not understand what you mean.
The "Policy 1 " data is in your original macro.

Or remove this line from macro: pt.PivotSelect "'Policy #1 '", xlDataAndLabel, True
And try again.
 
Upvote 0

Forum statistics

Threads
1,214,522
Messages
6,120,020
Members
448,939
Latest member
Leon Leenders

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