Pivot: VBA codes for Pivot Table

Refresh specific pivot table and add measures accordingly

Sub PivotRefresh()
Dim ws As Worksheet
Dim ws1 As Worksheet
Dim pt As PivotTable
Dim ptField(30) As PivotField
Dim Cur(30) As String
Dim i As Byte
Dim wb As Workbook
Set wb = ThisWorkbook
Set ws = wb.Sheets(PivotSht) 'change sheet name accordingly
Set ws1 = wb.Sheets(InputSht) 'change sheet name accordingly
Set pt = ws.PivotTables(1) 'change pivot number accordingly
'assign measures to array
For i = 1 To 30
    Cur(i) = ws1.Cells(2, i + 14)
Next i
With pt
    .PivotCache.Refresh
    For i = 21 To 30
        If i <= 24 Then
            Set ptField(i) = .AddDataField(.PivotFields(Cur(i) & "2"), Cur(i) & "2" & " ", xlSum)
            .InGridDropZones = True
            ptField(i).Position = i - 20
            .RowAxisLayout xlTabularRow
        Else
            Set ptField(i) = .AddDataField(.PivotFields(Cur(i) & "3"), Cur(i) & "3" & " ", xlSum)
            .InGridDropZones = True
            ptField(i).Position = i - 20
            .RowAxisLayout xlTabularRow
        End If
    Next i
End With
Set ws = Nothing
Set ws1 = Nothing
Set pt = Nothing
End Sub

---

Filter multiple items in Pivot

Sub FilterPivotItems()

Dim PT          As PivotTable
Dim PTItm       As PivotItem
Dim FiterArr()  As Variant

' use this array variable to select the items in the pivot table filter which you want to keep visible
FiterArr = Array("101", "105", "107")

' set the Pivot Table
Set PT = Sheet1.PivotTables("PivotTable1")

' loop through all Pivot Items in "Value" field of the Pivot
For Each PTItm In PT.PivotFields("Value").PivotItems

    If Not IsError(Application.Match(PTItm.Caption, FiterArr, 0)) Then ' check if current item is not in the filter array
        PTItm.Visible = True
    Else
        PTItm.Visible = False
    End If
Next PTItm

End Sub

---

Add custom sort list and apply on pivot

Sub AddandSort()

' custom sort order
Dim sCustomList(1 To 1) As String

sCustomList(1) = "SEK"
Application.AddCustomList ListArray:=sCustomList

Sheet28.PivotTables("PivotTable1").PivotFields( _
        "[PQuery1].[Currency].[Currency]").AutoSort xlAscending, _
        "[PQuery1].[Currency].[Currency]"

Sheet29.PivotTables("PivotTable2").PivotFields( _
        "[PQuery1].[Currency].[Currency]").AutoSort xlAscending, _
        "[PQuery1].[Currency].[Currency]"       

End Sub

---

Add fields into pivot table

Sub AddFieldsInPivot()

Dim thisPivot As PivotTable
Dim ptSheet As Worksheet
Dim ptField As PivotField
Set ptSheet = ThisWorkbook.Sheets("SheetNameWithPivotTable")
Set thisPivot = ptSheet.PivotTables(1)
With thisPivot
    Set ptField = .PivotFields("Gender")
    ptField.Orientation = xlRowField
    ptField.Position = 1
    Set ptField = .PivotFields("LastName")
    ptField.Orientation = xlRowField
    ptField.Position = 2
    Set ptField = .PivotFields("ShirtSize")
    ptField.Orientation = xlColumnField
    ptField.Position = 1
    Set ptField = .AddDataField(.PivotFields("Cost"), "Sum of Cost", xlSum)
    .InGridDropZones = True
    .RowAxisLayout xlTabularRow
End With

End Sub

---

Add or remove pivot calculated field without loop

Sub UpdatePivotWithOutLoop()

Dim pt As PivotTable
Dim pf As PivotField
Dim df As PivotField
Dim Forecast As String
Dim ThisYear As String
Dim PreYear As String

ThisYear = Left(Sheet11.Range("E6"), 4)
PreYear = Left(Sheet11.Range("F6"), 4)
Forecast = Sheet7.Range("E16")

Set pt = Sheet25.PivotTables("PivotTable1")

'remove all old fields
On Error Resume Next
For Each df In pt.DataFields
    If Right(df.SourceName, 3) = "TCK" Then
        With df
            .Orientation = xlHidden
        End With
    Else
        With df
            .Parent.PivotItems(.Name).Visible = False
        End With
    End If
    If Err.Number = 438 Or Err.Number = 1004 Then
       pt.PivotFields(df).Orientation = xlHidden
    End If
Next df
On Error GoTo 0

'add ISO to value
 pt.AddDataField pt.PivotFields(ThisYear & " ISO"), " " & ThisYear & " ISO", xlSum
 pt.AddDataField pt.PivotFields(PreYear & " ISO"), " " & PreYear & " ISO", xlSum   

'add Actuals to value
 pt.AddDataField pt.PivotFields(ThisYear & "A"), " " & ThisYear & "A", xlSum
 pt.AddDataField pt.PivotFields(PreYear & "A"), " " & PreYear & "A", xlSum

'add PreYear Actuals to value
 pt.AddDataField pt.PivotFields(Left(PreYear, 2) & "12A"), " " & Left(PreYear, 2) & "12A", xlSum

'add Forecast to value
 pt.AddDataField pt.PivotFields(Left(ThisYear, 2) & "12" & Forecast), " " & Left(ThisYear, 2) & "12" & Forecast, xlSum

'add Target to value
 pt.AddDataField pt.PivotFields(Left(ThisYear, 2) & "12TCK"), " " & Left(ThisYear, 2) & "12TCK", xlSum

'change fields position
pt.DataFields(" " & ThisYear & " ISO").Position = 1
pt.DataFields(" " & PreYear & " ISO").Position = 2
pt.DataFields(" " & ThisYear & "A").Position = 3
pt.DataFields(" " & PreYear & "A").Position = 4
pt.DataFields(" " & Left(PreYear, 2) & "12A").Position = 5
pt.DataFields(" " & Left(ThisYear, 2) & "12" & Forecast).Position = 6
pt.DataFields(" " & Left(ThisYear, 2) & "12TCK").Position = 7

Set pt = Nothing

End Sub

---

Add or remove pivot calculated field with loop

Sub UpdatePivotWithLoop()

Dim pt As PivotTable
Dim pf As PivotField
Dim df As PivotField
Dim LastISOYear As String
Dim LastISOMonth As String
Dim LastISO As String
Dim DFLast As String
Dim lkpISO As String
Dim Forecast As String
Dim ThisYear As String
Dim PreYear As String

ThisYear = Left(Sheet11.Range("E6"), 4)
PreYear = Left(Sheet11.Range("F6"), 4)
Forecast = Sheet7.Range("E16")
LastISOYear = Left(ThisYear, 2) - 2
LastISOMonth = Right(ThisYear, 2)
LastISO = LastISOYear & LastISOMonth & " ISO"
lkpISO = ThisYear & " ISO"

Set pt = Sheet30.PivotTables("PivotTable1")

'remove all old fields
On Error Resume Next
For Each df In pt.DataFields
    With df
        .Parent.PivotItems(.Name).Visible = False
    End With

        If Err.Number = 438 Or Err.Number = 1004 Then
            DFLast = df
            With df
                .Orientation = xlHidden
            End With 
            pt.PivotFields(df).Orientation = xlHidden
        End If
Next df
On Error GoTo 0

'add ISO to value
Do Until pt.DataFields(pt.DataFields.Count).Caption = " " & LastISO
    pt.AddDataField pt.PivotFields(lkpISO), " " & lkpISO, xlSum

    lkpISO = Application.WorksheetFunction.VLookup(lkpISO, Sheets("Matrix").Range("I:J"), 2, 0)

    If pt.DataFields(pt.DataFields.Count) < 3 Then
    On Error Resume Next
        With pt.DataFields(DFLast)
            .Parent.PivotItems(.Name).Visible = False
        End With
    On Error GoTo 0
    End If

Loop

Set pt = Nothing

End Sub