Rearranging multiple Pivot Table Columns using Macros

Question

Please dont close this question. I havent got a solution and its not a duplicate question, please understand the query.

I have a pivot table that has multiple columns, I want to dynamically rearrange the columns .

Sample pivot column header

Row Label	1 day	10 days	11 days	13 days	17 days	2 days	21 days	3 days

I want to rearrange this in ascending order. like this

Row Label	1 day	2 days	3 days	10 days	11 days	13 days	17 days	21 days

Points to note:

the pivot table is made dynamically
No assurity on column names remaining the same, it can change according to data set.
Data set cant be changed, cant edit it to 01 days,02 days etc.

Additionally, if this was a normal table/column we would have gone with a header sorting function (Code given below), can something of the same be applied here??

Specifically, storing values in an array, and using that to sort the pivot table column header??

Function Reorder_Columns()
  
Dim ColumnOrder As Variant, ndx As Integer, Found As Range, counter As Integer, ws As Worksheet
    Set ws = ActiveWorkbook.Sheets("Sheet1")
    ws.Activate
    
    ColumnOrder = Array("Item 1", "Item 2", "Item 3", "Item 4")
counter = 1

Application.ScreenUpdating = False
   
For ndx = LBound(ColumnOrder) To UBound(ColumnOrder)
    Set Found = Rows("1:1").Find(ColumnOrder(ndx), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
    If Not Found Is Nothing Then
        If Found.Column <> counter Then
            Found.EntireColumn.Cut
            Columns(counter).Insert Shift:=xlToRight
            Application.CutCopyMode = False
        End If
    counter = counter + 1
    End If
Next ndx
Application.ScreenUpdating = True

EDIT Answers given by Both Raymond Wu and Tim Williams are perfect for this with difference in time for each being .04 seconds.

Why not sort the column field. . You may not need VBA for that.. If VBA is must try recording the sort column field. Then you won't need to loop through all the fields. — Naresh
– Naresh, Commented Aug 5, 2021 at 5:39
For sorting column fields of a Pivot table in VBA ActiveSheet.PivotTables("PivotTable1").PivotFields("Column Labels").AutoSort xlAscending, "Column Labels".. Also, the code in the question doesn't look like for Pivot — Naresh
– Naresh, Commented Aug 5, 2021 at 5:48
Bottom of this page has something similar to what you want: contextures.com/excel-pivot-table-sorting.html — Tim Williams
– Tim Williams, Commented Aug 5, 2021 at 6:13
@Naresh Can't be done too, I think someone advised him before (in a deleted question) and he said he can't change the data. — Raymond Wu
– Raymond Wu, Commented Aug 5, 2021 at 6:18

Tim Williams · Accepted Answer · 2021-08-06 06:16:03Z

Here is a complete example including the sorting part:

Sub PTCustomFieldSort()

    Dim pt As PivotTable, pf As PivotField, pi As PivotItem, arr(), i As Long, pos As Long
    
    Set pt = ActiveSheet.PivotTables(1)
    Set pf = pt.PivotFields("Col2")
    
    'get an array of values for sorting
    ReDim arr(1 To pf.PivotItems.Count)
    For i = 1 To UBound(arr)
        arr(i) = pf.PivotItems(i).Name
    Next i
    SortSpecial arr, "SortVal"  'sort the array
    
    pt.ManualUpdate = True
    pos = 1
    'loop and order as wanted...
    For i = 1 To UBound(arr)
        Set pi = pf.PivotItems(arr(i))
        If pi.Visible Then
            pi.Position = pos
            pos = pos + 1
        End If
    Next i
    pt.ManualUpdate = False
    pt.PivotCache.Refresh
    pt.RefreshTable

End Sub



'Sorts an array using some specific translation defined in `func`
Sub SortSpecial(list, func As String)
    Dim First As Long, Last As Long, i As Long, j As Long, tmp, arrComp()
    First = LBound(list)
    Last = UBound(list)
    'fill the "compare array...
    ReDim arrComp(First To Last)
    For i = First To Last
        arrComp(i) = Application.Run(func, list(i))
    Next i
    'now sort by comparing on `arrComp` not `list`
    For i = First To Last - 1
        For j = i + 1 To Last
            If arrComp(i) > arrComp(j) Then
                tmp = arrComp(j)          'swap positions in the "comparison" array
                arrComp(j) = arrComp(i)
                arrComp(i) = tmp
                tmp = list(j)             '...and in the original array
                list(j) = list(i)
                list(i) = tmp
            End If
        Next j
    Next i
End Sub

Function SortVal(v)
    SortVal = Val(v) ' "1 day" --> 1, "11 days" --> 11 etc
End Function

my apologies, I had updated in the question rather than in the comments for each anwser, both approaches work and are comparable, time wise, to each other with a time difference of 0.4 seconds that could have been human error.

Raymond Wu · Accepted Answer · 2021-08-05 06:57:46Z

1

Modified from the code sample given in the link posted by Tim Williams, adapt the code below to your purpose:

Sub SortPT()
    Dim rngSort As Variant
    Dim pt As PivotTable
    Dim pf As PivotField
    Dim pi As PivotItem
    Dim lCount As Long
    On Error Resume Next
    Application.EnableEvents = False
    
    rngSort = Array("1 day", "2 days", "3 days", "10 days", "11 days") 'Adapt to your column headers in sequence
    
    Set pt = Worksheets("Sheet1").PivotTables("PivotTable1") 'Change to correct Worksheet and PivotTable name
    Set pf = pt.PivotFields("1 day") 'Change to the correct PivotField name
    lCount = 1
    
    pt.ManualUpdate = True
    With pf
      .AutoSort xlManual, pf.SourceName
      Dim i As Long
      For i = LBound(rngSort) To UBound(rngSort)
        Set pi = Nothing
        Set pi = .PivotItems(rngSort(i))
          If Not pi Is Nothing Then
            If pi.Visible = True Then
              pi.Position = lCount
              lCount = lCount + 1
            End If
          End If
      Next i
    End With
    
    pt.ManualUpdate = False
    pt.RefreshTable
    Application.EnableEvents = True
End Sub

answered Aug 5, 2021 at 6:57

Raymond Wu

3,4272 gold badges9 silver badges20 bronze badges

2 Comments

Allwyn P Over a year ago

my apologies, I had updated the feedback in the question rather than in the comments for each answer, both approaches work and are comparable, time wise, to each other with a time difference of 0.4 seconds that could have been human error.

Raymond Wu Over a year ago

@Allwyn All's good! IMO Tim's answer is better in the sense that you don't have to pre-define the sort array as it is done automatically from the extracted array of PivotItems.

Collectives™ on Stack Overflow

Rearranging multiple Pivot Table Columns using Macros

2 Answers 2

1 Comment

2 Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

1 Comment

2 Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related