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:

1. the pivot table is made dynamically
2. No assurity on column names remaining the same, it can change according to data set.
3. 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.

Answer 1

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

Answer 2

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