My pivot table opens with different number of rows and columns each
time when i refresh it.
How can I color it with correct rows and columns by vba ?
Something like:
clean previous color on the sheet
refresh pivot
color again

Any help ? Thank you very much.

' Put all this into a std. module and run the procedure
"Format_pivottable" while you have a worksheet active with a pivot
table. Due to page breaks on this formular you might need to correct a
few copy and paste errors before you can run it.

Option Explicit
Option Base 1
Public Declare Function GetAsyncKeyState Lib "user32.dll" (ByVal vKey
As Long) As Integer

Function Key_pressed(key_to_check As Long) As Boolean
If GetAsyncKeyState(key_to_check) And &H8000 Then
Key_pressed = True
Else
Key_pressed = False
End If
End Function

Sub Format_pivottable()
Dim r As Range
Dim i As Integer
Dim pt As PivotTable
Dim s As String
Dim currencii As Boolean
Dim pn()

currencii = Key_pressed(vbKeyControl)

Set r = Selection ' just for restoration at the end of the
formating

On Error Resume Next
Set pt = ActiveCell.PivotTable ' first will see whether there is
an active pivot table
If pt Is Nothing Then
Set pt = ActiveSheet.PivotTables(1) ' lets see whether there
is at least one pivot table on the sheet
If pt Is Nothing Then
MsgBox "Error: Can't find pivot table on the active
sheet!"
Exit Sub
End If
End If

pt.HasAutoFormat = False ' switch off Autoformat to clear all
old formats,
' this will restore the "button look"
for the whole cells at the top
pt.PreserveFormatting = False
pt.PreserveFormatting = True

BasicPivotTableFormat pt

If pt.ColumnFields.Count 1 Then
ReDim pn(pt.ColumnFields.Count)
For i = 1 To pt.ColumnFields.Count
pn(pt.ColumnFields(i).Position) = pt.ColumnFields
(i).Name ' store Columnfield names in the buffer
Next i '
sorted by position
For i = 1 To pt.ColumnFields.Count - 1
Debug.Print "CF:" & i & " Pos.: " & pt.ColumnFields(pn
(i)).Position & " " & pt.ColumnFields(pn(i)).Name
If pt.ColumnFields(pn(i)).Subtotals(2) = True Then
s = "'" & pt.ColumnFields(pn(i)).Name & "'[All;Sum]"
pt.PivotSelect s, xlDataAndLabel, True
ColorColumnFieldSelection (pt.ColumnFields(pn(i)))
ElseIf pt.ColumnFields(pn(i)).Subtotals(1) = True Then
s = "'" & pt.ColumnFields(pn(i)).Name & "'[All;Total]"
pt.PivotSelect s, xlDataAndLabel, True
ColorColumnFieldSelection (pt.ColumnFields(pn(i)))
End If
Next i
End If

If pt.RowFields.Count 1 Then
ReDim pn(pt.RowFields.Count)
For i = 1 To pt.RowFields.Count
pn(pt.RowFields(i).Position) = pt.RowFields(i).Name '
store Rowfield names in the buffer
Next i '
sorted by position
For i = 1 To pt.RowFields.Count - 1
Debug.Print "RF:" & i & " Pos.: " & pt.RowFields(pn
(i)).Position & " " & pt.RowFields(pn(i)).Name
If pt.RowFields(pn(i)).Subtotals(2) = True Then
s = "'" & pt.RowFields(pn(i)).Name & "'[All;Sum]"
pt.PivotSelect s, xlDataAndLabel, True
ColorRowFieldSelection (pt.RowFields(pn(i)))
ElseIf pt.RowFields(pn(i)).Subtotals(1) = True Then
s = "'" & pt.RowFields(pn(i)).Name & "'[All;Total]"
pt.PivotSelect s, xlDataAndLabel, True
ColorRowFieldSelection (pt.RowFields(pn(i)))
End If
Next i
End If

pt.DataBodyRange.Select
If currencii Then
Selection.NumberFormat = "0"
Selection.Style = "Currency"
End If

Selection.Offset(-1, -1).Resize(Selection.Rows.Count + 1,
Selection.Columns.Count + 1).Select
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlHairline
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlHairline
End With

r.Select ' restore old cell selection
End Sub

Sub BasicPivotTableFormat(Optional pt As PivotTable)
' called by Format_pivottable()
If pt Is Nothing Then Set pt = getPivotTable
If Not pt Is Nothing Then
Sheets(pt.Parent.Name).Select
selectColumnHeaderRange pt
With Selection
.Interior.ColorIndex = 33
.Interior.Pattern = xlSolid
.Font.Bold = True
End With

selectRowHeaderRange pt
With Selection
.Interior.ColorIndex = 34
.Interior.Pattern = xlSolid
.Font.Bold = True
End With

selectDataBodyRange pt
With Selection
.Interior.ColorIndex = 36
.Interior.Pattern = xlSolid
.Font.Bold = False
Debug.Print "DataBodyRange.NumberFormat", .NumberFormat
' .NumberFormat = "0"
End With

selectButtonRange pt
Selection.Font.Bold = True
If Application.Version = "12.0" Then
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = 1 'xlThemeColorDark1
.TintAndShade = -0.05
.PatternTintAndShade = 0
End With
End If

selectColumnHeaderRange pt
With Selection
.ColumnWidth = 15
.WrapText = True
.EntireRow.AutoFit
End With

If pt.RowGrand = True Then
pt.PivotSelect "'Row Grand Total'", xlDataAndLabel,
UseStandardName:=True
With Selection
.Interior.ColorIndex = 17
.Interior.Pattern = xlSolid
.Font.Bold = True
.ColumnWidth = 15
.EntireRow.AutoFit
End With
End If

If pt.ColumnGrand = True Then
pt.PivotSelect "'Column Grand Total'", xlDataAndLabel,
UseStandardName:=True
With Selection
.Interior.ColorIndex = 33
.Interior.Pattern = xlSolid
.Font.Bold = True
End With
End If

End If
End Sub
'

Function getPivotTable() As PivotTable
Dim ch As ChartObject
On Error Resume Next

Set ch = ActiveChart
If Not ch Is Nothing Then
Set getPivotTable = ActiveChart.PivotLayout.PivotTable ' 1st
will see whether we have an active pivot chart
If Not getPivotTable Is Nothing Then Exit Function
End If

Set getPivotTable = ActiveCell.PivotTable ' 2nd will see whether
there is an active pivot table
If Not getPivotTable Is Nothing Then Exit Function

Set getPivotTable = ActiveSheet.PivotTables(1) ' lets see
whether there is at least one pivot table on the sheet
If Not getPivotTable Is Nothing Then Exit Function

Set getPivotTable = ActiveSheet.PivotLayout.PivotTable ' as a
last check lets look for a pivot chart
If Not getPivotTable Is Nothing Then Exit Function

If ActiveSheet.ChartObjects.Count 0 Then ' or an
embedded pivot chart
For Each ch In ActiveSheet.ChartObjects
If ch.Chart.HasPivotFields Then
Set getPivotTable = ch.Chart.PivotLayout.PivotTable
Exit For
Else
Set getPivotTable = Nothing
End If
Next ch
Else ' done our best to find the pivot
table that we can work with
Set getPivotTable = Nothing ' this should trigger an error
message in the caller now.
End If

End Function

Sub set_all_datafields_to_Sum()

Dim pt As PivotTable ' pivot table object handle
Dim df As PivotField

' On Error Resume Next
Set pt = getPivotTable
If Not pt Is Nothing Then
For Each df In pt.DataFields
df.Function = xlSum
Next df
Else
MsgBox "No Pivot Table selected/on this sheet!"
End If
On Error GoTo 0

End Sub
Function PivotItemSelect(pf As PivotField, pfit As PivotItem, mode As
XlPTSelectionMode) As Range
Err.Clear
On Error Resume Next
pfit.Parent.Parent.PivotSelect pf.Name & "[" & pfit.Name & "]",
mode, True
If Err.Number < 0 Then
Set PivotItemSelect = Nothing
Else
Set PivotItemSelect = Selection
If mode = xlLabelOnly And (pf.Subtotals(1) = True Or
pf.Subtotals(2) = True) Then
pfit.Parent.Parent.PivotSelect pf.Name & "[" & pfit.Name &
"]", xlDataAndLabel, True
Range(Cells(Selection.Row + Selection.Rows.Count,
Selection.Column), _
Cells(Selection.Row + Selection.Rows.Count, _
Selection.Areas(Selection.Areas.Count).Column
+ Selection.Areas(Selection.Areas.Count).Columns.Cou nt - 1)).Select
' Debug.Print PivotItemSelect.Address,
Selection.Address
Set PivotItemSelect = Union(PivotItemSelect, Selection)
PivotItemSelect.Select
End If
End If
Err.Clear
On Error GoTo 0
End Function

Sub ColorRowFieldSelection(rf As PivotField)
On Error Resume Next ' required if there are no subtotals in
automatic mode (can happen)
Debug.Print "color row field", rf.Name, rf.Position
If rf.Position = 1 Then
Selection.Font.Bold = True
Selection.Interior.ColorIndex = 42
ElseIf rf.Position = 2 Then
Selection.Font.Bold = True
Selection.Interior.ColorIndex = 43
ElseIf rf.Position = 3 Then
Selection.Font.Bold = True
Selection.Interior.ColorIndex = 44
Else
Selection.Interior.ColorIndex = 45
End If
On Error GoTo 0
End Sub
Sub ColorColumnFieldSelection(cf As PivotField)
On Error Resume Next ' required if there are no subtotals in
automatic mode (can happen)
Debug.Print "color column field", cf.Name, cf.Position
If cf.Position = 1 Then
Selection.Font.Bold = True
Selection.Interior.ColorIndex = 41
ElseIf cf.Position = 2 Then
Selection.Font.Bold = True
Selection.Interior.ColorIndex = 2
ElseIf cf.Position = 3 Then
Selection.Font.Bold = True
Selection.Interior.ColorIndex = 33
Else
Selection.Interior.ColorIndex = 15
End If
On Error GoTo 0
End Sub

Sub selectRowGrandTotals(Optional pt As PivotTable)
If pt Is Nothing Then Set pt = getPivotTable
If Not pt Is Nothing Then
Sheets(pt.Parent.Name).Select
RowGrandTotalsRange(pt).Select
Else
MsgBox "No pivot tables on the active sheet."
End If
End Sub
Sub selectColumnGrandTotals(Optional pt As PivotTable)
Dim X As Range
If pt Is Nothing Then Set pt = getPivotTable
If Not pt Is Nothing Then
Set X = pt.DataBodyRange
With pt
.ColumnGrand = True
End With
Sheets(pt.Parent.Name).Select
X.Range(Cells(X.Rows.Count, 1), Cells(X.Rows.Count,
X.Columns.Count)).Select
Else
MsgBox "No pivot tables on the active sheet."
End If
End Sub
Function RowGrandTotalsRange(Ptable As PivotTable) As Range
With Ptable
.RowGrand = True
End With
Set RowGrandTotalsRange = Ptable.DataBodyRange.Range( _
Sheets(Ptable.Parent.Name).Cells(1, _
Ptable.DataBodyRange.Columns.Count), _
Sheets(Ptable.Parent.Name).Cells
(Ptable.DataBodyRange.Rows.Count, _
Ptable.DataBodyRange.Columns.Count))
End Function
Sub selectButtonRange(Optional pt As PivotTable)
On Error Resume Next
If pt Is Nothing Then Set pt = getPivotTable
If Not pt Is Nothing Then
Sheets(pt.Parent.Name).Select
ButtonRange(pt).Select
Else
MsgBox "No pivot tables on the active sheet."
End If
End Sub
Sub selectColumnHeaderRange(Optional pt As PivotTable)
On Error Resume Next
If pt Is Nothing Then Set pt = getPivotTable
If Not pt Is Nothing Then
Sheets(pt.Parent.Name).Select
ColumnHeaderRange(pt).Select
Else
MsgBox "No pivot tables on the active sheet."
End If
End Sub
Sub selectRowHeaderRange(Optional pt As PivotTable)
On Error Resume Next
If pt Is Nothing Then Set pt = getPivotTable
If Not pt Is Nothing Then
Sheets(pt.Parent.Name).Select
RowHeaderRange(pt).Select
Else
MsgBox "No pivot tables on the active sheet."
End If
End Sub

Sub selectDataBodyRange(Optional pt As PivotTable)
On Error Resume Next
If pt Is Nothing Then Set pt = getPivotTable
If Not pt Is Nothing Then
Sheets(pt.Parent.Name).Select
pt.DataBodyRange.Select
Exit Sub
End If
MsgBox "No pivot tables on the active sheet."
End Sub
Function ButtonRange(Ptable As PivotTable) As Range
Dim str1 As Range, str2 As Range, str3 As Range
Dim ColrngRows As Long
Dim ColrngCols As Long
With Ptable
ColrngRows = .ColumnRange.Rows.Count
ColrngCols = .ColumnRange.Columns.Count
Set str1 = .RowRange.Offset(1 - ColrngRows, 0).Resize
(ColrngRows, .RowRange.Columns.Count)
Set str2 = .ColumnRange.Resize(1, ColrngCols)
On Error Resume Next
Set str3 = .PageRange.Resize(.PageRange.Rows.Count, 1)
On Error GoTo 0
End With

If Not str1 Is Nothing And Not str2 Is Nothing And Not str3 Is
Nothing Then
Set ButtonRange = Union(str1, str2, str3)
Else
Set ButtonRange = Union(str1, str2)
End If
End Function
Function ColumnHeaderRange(Ptable As PivotTable) As Range
With Ptable
Set ColumnHeaderRange = .ColumnRange.Offset(1, 0).Resize
(.ColumnRange.Rows.Count - 1, .ColumnRange.Columns.Count)
End With
End Function
Function RowHeaderRange(Ptable As PivotTable) As Range
With Ptable
Set RowHeaderRange = .RowRange.Offset(1, 0).Resize
(.RowRange.Rows.Count - 1, .RowRange.Columns.Count)
End With
End Function

Thank you very much minimaster.