How can I make this macro work on all sheets in an Excel workbook?-CodePudding

I have recorded the macro below and I'd like it to work on all sheets / tables in the workbook. I've gathered that I need to replace "ActiveWorkbook.Worksheets("Ramp")" with "ActiveWorkbook.ActiveSheet.ListObjects" but I cannot figure how to get the sort to work.

macro that works on the sheet which I recorded it on:

Sub GateSort()
'
' GateSort Macro
' Automatic sorting by Terminal > Gate > Subordinate value
'
' Keyboard Shortcut: Ctrl Shift G
'
    ActiveWorkbook.Worksheets("Ramp").ListObjects("Table1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Ramp").ListObjects("Table1").Sort.SortFields.Add2 _
        Key:=Range("Table1[Sort Gate Leading]"), SortOn:=xlSortOnValues, Order:= _
        xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Ramp").ListObjects("Table1").Sort.SortFields.Add2 _
        Key:=Range("Table1[Sort Gate Number]"), SortOn:=xlSortOnValues, Order:= _
        xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Ramp").ListObjects("Table1").Sort.SortFields.Add2 _
        Key:=Range("Table1[Sort Gate Trailing]"), SortOn:=xlSortOnValues, Order:= _
        xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Ramp").ListObjects("Table1").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

My current attempt:

Sub GateSort()
'
' GateSort Macro
' Automatic sorting by Terminal > Gate > Subordinate value
'
' Keyboard Shortcut: Ctrl Shift G
'
tName = ActiveCell.ListObject.Name

    ActiveWorkbook.ActiveSheet.ListObjects(tName).Sort.SortFields.Clear
    ActiveWorkbook.ActiveSheet.ListObjects(tName).Sort.SortFields.Add2 _
        Key:=Range("tName[Sort Gate Leading]"), SortOn:=xlSortOnValues, Order:= _
        xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.ActiveSheet.ListObjects(tName).Sort.SortFields.Add2 _
        Key:=Range("tName[Sort Gate Number]"), SortOn:=xlSortOnValues, Order:= _
        xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.ActiveSheet.ListObjects(tName).Sort.SortFields.Add2 _
        Key:=Range("tName[Sort Gate Trailing]"), SortOn:=xlSortOnValues, Order:= _
        xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.ActiveSheet.ListObjects(tName).Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

I've been playing with variables as indicated above though I've not had success. This is all to avoid manually creating a multi-level sort when needed.

CodePudding user response：

Assuming all ListObjects in the workbook share at least those same 3 columns:

Sub GateSort()
    
    Dim wb As Workbook, ws As Worksheet, lo As ListObject
    
    Set wb = ActiveWorkbook
    For Each ws In wb.Worksheets       'loop over worksheets
        For Each lo In ws.ListObjects  'loop over listobjects in `ws`
            With lo.Sort
                .SortFields.Clear
                .SortFields.Add2 Key:=lo.ListColumns("Sort Gate Leading").Range, _
                    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                .SortFields.Add2 Key:=lo.ListColumns("Sort Gate Number").Range, _
                    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                .SortFields.Add2 Key:=lo.ListColumns("Sort Gate Trailing").Range, _
                    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
        Next lo
    Next ws
End Sub

CodePudding user response：

Sort Tables Identified By Their Headers

Sub GateSort()
'
' GateSort Macro
' Automatic sorting by Terminal > Gate > Subordinate value
'
' Keyboard Shortcut: Ctrl Shift G
'
    Const PROC_TITLE As String = "Gate Sort"

    Dim ColumnNames() As Variant: ColumnNames = VBA.Array( _
        "Sort Gate Leading", "Sort Gate Number", "Sort Gate Trailing")
        
    If ActiveSheet Is Nothing Then Exit Sub ' no visible workbooks open
    If Not TypeOf ActiveSheet Is Worksheet Then Exit Sub ' not a worksheet
    If ActiveSheet.ListObjects.Count = 0 Then Exit Sub ' has no tables
    
    Dim nUpper As Long: nUpper = UBound(ColumnNames)
    
    Dim ws As Worksheet: Set ws = ActiveSheet
    
    Dim lo As ListObject
    Dim lc As ListColumn
    Dim rg As Range
    Dim n As Long
    Dim MsgString As String
    
    ' Loop over all tables in the active worksheet.
    For Each lo In ws.ListObjects
        With lo
            ' Check if all column names exist in the table headers.
            For n = 0 To nUpper
                On Error Resume Next
                    Set lc = .ListColumns(ColumnNames(n))
                On Error GoTo 0
                If Not lc Is Nothing Then Set lc = Nothing Else Exit For
            Next n
            ' Sort the table.
            If n > nUpper Then ' all column names exist
                MsgString = MsgString & vbLf & vbTab & .Name
                With .Sort
                   With .SortFields
                       .Clear
                       For n = 0 To nUpper
                           Set lc = .ListColumns(ColumnNames(n))
                           Set rg = lc.Range
                           .Add2 rg, xlSortOnValues, xlAscending, , xlSortNormal
                        Next n
                   End With
                    .Header = xlYes
                    .MatchCase = False
                    .Orientation = xlTopToBottom
                    .SortMethod = xlPinYin
                    .Apply
                End With
            'Else ' not all column names exist; do nothing
            End If
        End With
    Next lo
    
    If Len(MsgString) = 0 Then
        MsgString = "No Gate tables found."
        MsgBox MsgString, vbExclamation, PROC_TITLE
    Else
        MsgString = "Gate Sort applied in worksheet '" & ws.Name _
            & "' on the following tables:" & MsgString
        MsgBox MsgString, vbInformation, PROC_TITLE
    End If
    
End Sub