How to do multiple pivotselect with VBA?

[rumshar]

Hi Awesome guys,
I have developed a pivot table, which is attached herewith. In this PT I want to highlight different years in different colors. Is there any easier way to do this? I know how to do it manually but I am looking for VBA solution. I tried doing with for next loop but it didn't help. The problem is I don't know what exactly the these items(as in my file) are called in VBA.

 

[PeterB]

Hi Rumshar,

Try this:

Sub PivotHighlight()

Dim pt As PivotTable
Dim pf As PivotField
Dim pi As PivotItem
Dim rng As Range
Dim n As Byte

Set pt = ThisWorkbook.Sheets("Pivot").PivotTables(1)
Set pf = pt.PivotFields("Years")

For Each pi In pf.PivotItems

  If Not Len(pi.Name) > 4 Then
    n = n + 1
    Set rng = Intersect(pi.DataRange.EntireRow, pt.TableRange1)
    Call HighlightCells(rng, n)
  End If

Next pi

'Clean up
Set rng = Nothing
Set pi = Nothing
Set pf = Nothing
Set pt = Nothing

End Sub



Private Sub HighlightCells(ByVal rng As Range, ByVal n As Byte)

Dim dblcolor As Double
Dim iThemeColor As Byte

If n = 1 Then
  dblcolor = 0.599993896298105  'Light Blue
  iThemeColor = xlThemeColorAccent1
ElseIf n = 2 Then
  dblcolor = 0.399975585192419  'Light green
  iThemeColor = xlThemeColorAccent6
ElseIf n = 3 Then
  dblcolor = 0.599993896298105  'Light yellow
  iThemeColor = xlThemeColorAccent4
ElseIf n = 4 Then
  dblcolor = 0.599993896298105  'Light purple
  iThemeColor = xlThemeColorAccent2
End If


With rng.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = iThemeColor
    .TintAndShade = dblcolor
    .PatternTintAndShade = 0
End With

End Sub

Regards,

Peter

 

[rumshar]

Hi Peter,
Thank you very much for your prompt reply. Thanks a lot.

Hi Rumshar,

Try this:

Sub PivotHighlight()

Dim pt As PivotTable
Dim pf As PivotField
Dim pi As PivotItem
Dim rng As Range
Dim n As Byte

Set pt = ThisWorkbook.Sheets("Pivot").PivotTables(1)
Set pf = pt.PivotFields("Years")

For Each pi In pf.PivotItems

  If Not Len(pi.Name) > 4 Then
    n = n + 1
    Set rng = Intersect(pi.DataRange.EntireRow, pt.TableRange1)
    Call HighlightCells(rng, n)
  End If

Next pi

'Clean up
Set rng = Nothing
Set pi = Nothing
Set pf = Nothing
Set pt = Nothing

End Sub



Private Sub HighlightCells(ByVal rng As Range, ByVal n As Byte)

Dim dblcolor As Double
Dim iThemeColor As Byte

If n = 1 Then
  dblcolor = 0.599993896298105  'Light Blue
  iThemeColor = xlThemeColorAccent1
ElseIf n = 2 Then
  dblcolor = 0.399975585192419  'Light green
  iThemeColor = xlThemeColorAccent6
ElseIf n = 3 Then
  dblcolor = 0.599993896298105  'Light yellow
  iThemeColor = xlThemeColorAccent4
ElseIf n = 4 Then
  dblcolor = 0.599993896298105  'Light purple
  iThemeColor = xlThemeColorAccent2
End If


With rng.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = iThemeColor
    .TintAndShade = dblcolor
    .PatternTintAndShade = 0
End With

End Sub

Regards,

Peter

Hi Awesome guys,
I have developed a pivot table, which is attached herewith. In this PT I want to highlight different years in different colors. Is there any easier way to do this? I know how to do it manually but I am looking for VBA solution. I tried doing with for next loop but it didn't help. The problem is I don't know what exactly the these items(as in my file) are called in VBA.