VBA: Adding and Removing Pivot Data Fields

ST_Excel

New Member
Joined
Jan 15, 2017
Messages
2
Hi All,

I am new to VBA, and am looking at ways to have pivot columns show up, based on a data validation list - so that the user can select a location in a cell, and then the pivot table updates to show only the column related to that Location. The locations are set up as columns in the database, hence why I cannot just use a slicer - the data doesn't summarise properly.

The code I have aims to remove all fields, and then add in only the necessary one, based on the cell "D1". I can then replicate for each of the data validation values with the code (approx 30 locations). The first location is "Outlet1", and I need it to change if the cell text changes to "Outlet2", "Outlet3" etc. So essentially, the user can select the columns in a pivot table, without completing the drag and drop into the data field section. The code so far is:

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim oWS As Worksheet
Dim Cell As Range, myRange As Range
Dim celltxt As String, celltxt2 As String
Dim PT As PivotTable, PTField As PivotField, PTItem As PivotItem
Set oWS = ActiveSheet
Set PT = oWS.PivotTables("PivotTable2")
Application.ScreenUpdating = False
If Intersect(Target, Range("myRange")) Is Nothing Then Exit Sub
If Target.Address = "$D$1" Then
'ADFA
If celltxt = "Outlet1" Then
With PT
.ManualUpdate = True
For Each PTField In PT.DataFields
Set PTItem = PTField.DataRange.Cells(1, 1).PivotItem
PTItem.DataRange.Select
PTItem.Visible = False
.ManualUpdate = False
Next
    With ActiveSheet.PivotTables("PivotTable2").PivotFields("Outlet1")
    .ManualUpdate = True
        .Orientation = xlDataField
        .Caption = "Sum of Outlet1"
        .Function = xlSum
        .NumberFormat = "$#,##0;[Red]-$#,##0"
    PTItem.Visible = True
    End With
    ActiveSheet.PivotTables("PivotTable2").PivotFields("Item Code").AutoSort _
        xlDescending, "Sum of AOutlet1
    Range("G6").Select
    ActiveCell.FormulaR1C1 = _
        "=IFERROR(G6/GETPIVOTDATA("""Outlet1",$B$4,""Year"",""2017 Sales Revenue ($)""),"""")"
    Range("G6").Select
    Selection.AutoFill Destination:=Range(Selection, ActiveCell.Offset(0, -1).End(xlDown).Offset(0, 1))
Application.ScreenUpdating = True
.ManualUpdate = False
End With
End If
End If
End Sub

Any help wuold be appreciated, I am struggling with this one!

Cheers,

Sarah
 
Last edited by a moderator:

Excel Facts

What does custom number format of ;;; mean?
Three semi-colons will hide the value in the cell. Although most people use white font instead.
Hi All,

So I have managed to achieve the changing of pivot table columns based on a cell value, however, now I am stuck on being able to sort the data from highest to lowest. The code I now have is:
Rich (BB code):
Sub Adjust2()
Dim oWS As Worksheet
On Error Resume Next
Dim pf As PivotField
Dim celltxt As String
Dim curm As String
Dim xlDescending As Long
Set oWS = Worksheets("2016 v 2017")
   For Each pf In oWS.PivotTables("PTSales").DataFields
        curm = pf.Name
   Next pf
celltxt = oWS.Range("myRange")
If celltxt = Right(curm, 6) Then Exit Sub
Application.ScreenUpdating = False
    Worksheets("2016 v 2017").PivotTables("PTSales").AddFields RowFields:=Array("Item Name"), ColumnFields:=Array("Year")
    Worksheets("2016 v 2017").PivotTables("PTSales").PivotFields(curm). _
        Orientation = xlHidden
    With Worksheets("2016 v 2017").PivotTables("PTSales").PivotFields(celltxt)
        .Orientation = xlDataField
        .Caption = celltxt & " Sales"
        .Function = xlSum
        .NumberFormat = "$#,##0;[Red]-$#,##0"
    End With

!!!!!!THIS LINE DOESN"T APPEAR TO BE WORKING!!!!!
 Worksheets("2016 v 2017").PivotTables("PTSales").PivotField("Item Name").AutoSort xlDescending, "celltxt & "" Sales"""
    
    Range("F7:F15000").Clear
    Range("F6").Select
    Selection.AutoFill Destination:=Range(Selection, ActiveCell.Offset(0, -1).End(xlDown).Offset(0, 1))
Application.ScreenUpdating = True
End Sub
Is there any way to automatically sort, based on a changing column name?

Cheers,

Sarah
 
Last edited by a moderator:
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,213
Members
448,554
Latest member
Gleisner2

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