Get Pivot table names as per their physical order in the sheet

Question

Main Excel Sheet

As you can see in the image, there are some pivot tables on the Excel sheet. Although they are named PivotTable1 to PivotTable11, they aren't present in the same physical order in the sheet. I want to get the names of the pivot tables in the physical order in which they are present on the sheet.

I tried using ChatGPT, but it's not able to help. This is part of a bigger project where there are hundreds of pivot tables. Can anyone help with a VBA code to do the same?

I'm getting this

but I want this

The Code

Sub GetPivotTableRange()
    'GetPivotTableRange
    Dim pt As PivotTable
    Dim ptRange As Range
    Dim ptName As String
    
    'Loop through all the PivotTables in the active worksheet
    For Each pt In ActiveSheet.PivotTables
        'Get the PivotTable name and range
        ptName = pt.Name
        Set ptRange = pt.TableRange1
        
        'Display the range in the desired format
        Range(ptRange.Cells(1, 1), ptRange.Cells(1, ptRange.Columns.Count)).Select
        Dim rangeAddress As String
        rangeAddress = ActiveWindow.Selection.Address
        rangeAddress = Replace(rangeAddress, "$", "")
        rangeAddress = Replace(rangeAddress, ":", ":")
        rangeAddress = Replace(rangeAddress, "1", "")
        rangeAddress = Replace(rangeAddress, "2", "")
        rangeAddress = Replace(rangeAddress, "3", "")
        rangeAddress = Replace(rangeAddress, "4", "")
        rangeAddress = Replace(rangeAddress, "5", "")
        rangeAddress = Replace(rangeAddress, "6", "")
        rangeAddress = Replace(rangeAddress, "7", "")
        rangeAddress = Replace(rangeAddress, "8", "")
        rangeAddress = Replace(rangeAddress, "9", "")
        rangeAddress = Replace(rangeAddress, "0", "")
        
        'Display the PivotTable name and range address
        Debug.Print ptName & "= " & rangeAddress
    Next pt

End Sub

Loop over the worksheet and list out the tables to a worksheet, along with their ranges and column number of the top-left cell, and then sort the list by column number. — Tim Williams, May 16 '23 at 21:23
Please share the code you have tried to get the undesired result so we can build on it. — VBasic2008, May 16 '23 at 21:49

Tim Williams · Answer 1 · 2023-05-16T23:56:46.170

Try this out: it collects all Pivottables and their left-most column number into a Collection, then sorts that collection based on the column number.

Sub ListPivotTables()
    Dim pt As PivotTable, ptRange As Range, ptName As String
    Dim col As New Collection, el
    
    'collect all the PT on the sheet
    Debug.Print vbLf & "Unsorted:"
    For Each pt In ActiveSheet.PivotTables
        col.Add Array(pt, pt.TableRange1.Cells(1).Column)
        Debug.Print pt.Name & "= " & _
                    pt.TableRange1.EntireColumn.Address(False, False)
    Next pt
    
    SortCollection col, 2   'sort the collection on the second element (column#)
    
    'print out the sorted PT
    Debug.Print vbLf & "Sorted:"
    For Each el In col
        Set pt = el(0)
        Debug.Print pt.Name & "= " & _
                    pt.TableRange1.EntireColumn.Address(False, False)
    Next el

End Sub

'Sort a collection of 0-based arrays in ascending order by the n'th element of each array
'Adapted from https://stackoverflow.com/a/3588073/478884
Sub SortCollection(col As Collection, n As Long, Optional AscendingSort As Boolean = True)
    Dim i As Long, j As Long, vTemp As Variant, v1, v2
    For i = 1 To col.Count - 1 'Two loops to bubble sort
        For j = i + 1 To col.Count
            v1 = col(i)(n - 1)
            v2 = col(j)(n - 1)
            If IIf(AscendingSort, v1 > v2, v1 < v2) Then
                vTemp = col(j)
                col.Remove j
                col.Add Item:=vTemp, before:=i
            End If
        Next j
    Next i
End Sub

Get Pivot table names as per their physical order in the sheet

1 Answers1