1

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.

VBasic2008
  • 44,888
  • 5
  • 17
  • 28
BMax1985
  • 13
  • 3
  • 1
    You need to replace _all_ uses of `Active*` with variables you set to the required objects. [See here](https://stackoverflow.com/q/10714251) – chris neilsen Nov 23 '22 at 18:02
  • Do all the sheets have the same column names? (i.e. "Gate Leading")? ANd if so, would the macro apply the same when they exist? – pgSystemTester Nov 23 '22 at 18:47

2 Answers2

0

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
Tim Williams
  • 154,628
  • 8
  • 97
  • 125
  • For this I end up with run-time error 9. Subscript out of range on the sort after .sortfields.clear. The worksheets do all have those columns. – BMax1985 Nov 28 '22 at 16:29
  • Then maybe there's not a column with that heading? – Tim Williams Nov 28 '22 at 16:30
  • The headings are there. I ran it on the worksheet that my current macro runs on. – BMax1985 Nov 28 '22 at 17:46
  • Works fine for me as long as all tables have all 3 headings - other wise I get the same error you describe. – Tim Williams Nov 28 '22 at 18:29
  • Not sure but I have other headings of course though I don't think they should interfere. I did get it though so thank you for the assistance but it's taken care of. – BMax1985 Nov 28 '22 at 19:45
0

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 = .Parent.Parent.ListColumns(ColumnNames(n))
                            Set rg = lc.Range
                            .Add2 _
                                rg, xlSortOnValues, xlAscending, , xlSortNormal
                        Next n
                        Set lc = Nothing
                    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
VBasic2008
  • 44,888
  • 5
  • 17
  • 28
  • This seems to be the ticket but I end up with Run-time error 438 "Object doesn't support this property or Method on the sort table if statement and debugger identifies line "Set lc = .ListColumns(ColumnNames(n))" – BMax1985 Nov 28 '22 at 16:03
  • `.SortFields.ListColumns...` is not possible so I fixed it with `.Parent.Parent` which is actually `lo` (looking from `.SortFields`, the 1st parent is `.Sort` while the 2nd parent is `lo`). Also, the `Set lc = Nothing` following the 2nd `For n = 0...` loop was missing for the 1st `For n = 0...` loop to work correctly. Sorry. – VBasic2008 Nov 28 '22 at 17:46