Auto-Sort VBA Code Amendment

[ahem27]

Hello All,

I found the below VBA code on another site that auto sorts the list in a certain Table/Column as you enter data.

It works fine (after renaming the table and column ranges to match my particular spreadsheet.)

However, I have more than one Table/Column I need this code to apply to.

Does anyone have any suggestions for how I can add additional Table/Column ranges to this code?

Thank you very much for any assistance!

Private Sub Worksheet_Change(ByVal Target As Range)

Dim SalesTable As ListObject
Dim SortCol As Range

Set SalesTable = ActiveSheet.ListObjects("Table_Name")
Set SortCol = Range("Table_Name[Column_Name]")

If Not Intersect(Target, SortCol) Is Nothing Then
    With SalesTable.Sort
        .SortFields.Clear
        .SortFields.Add Key:=SortCol, Order:=xlDescending
        .Header = xlYes
        .Apply
    End With
End If
End Sub

 

[kevin9999]

Please try the following on a copy of your workbook

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Escape
    Application.EnableEvents = False
    Dim SalesTable As ListObject
    Dim SortCol As Range
    
    If Not Target.ListObject Is Nothing Then
        Set SalesTable = Target.ListObject
        Set SortCol = Intersect(Target.ListObject.HeaderRowRange, Target.EntireColumn)
        With SalesTable.Sort
            .SortFields.Clear
            .SortFields.Add Key:=SortCol, Order:=xlDescending
            .Header = xlYes
            .Apply
        End With
    End If

Continue:
    Application.EnableEvents = True
    Exit Sub
Escape:
    MsgBox "Error " & Err.Number & ": " & Err.Description
    Resume Continue
End Sub

 

[Peter_SSs]

@ahem27
When posting vba code in the forum, please use the available code tags. It makes your code much easier to read/debug & copy. My signature block below has more details. I have added the tags for you this time.

 

[ahem27]

Please try the following on a copy of your workbook

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Escape
    Application.EnableEvents = False
    Dim SalesTable As ListObject
    Dim SortCol As Range
   
    If Not Target.ListObject Is Nothing Then
        Set SalesTable = Target.ListObject
        Set SortCol = Intersect(Target.ListObject.HeaderRowRange, Target.EntireColumn)
        With SalesTable.Sort
            .SortFields.Clear
            .SortFields.Add Key:=SortCol, Order:=xlDescending
            .Header = xlYes
            .Apply
        End With
    End If

Continue:
    Application.EnableEvents = True
    Exit Sub
Escape:
    MsgBox "Error " & Err.Number & ": " & Err.Description
    Resume Continue
End Sub

This is perfect!
Thank you so much!

 

[ahem27]

@ahem27
When posting vba code in the forum, please use the available code tags. It makes your code much easier to read/debug & copy. My signature block below has more details. I have added the tags for you this time.

Understood. I will remember this for next time. Thank you!

 

[kevin9999]

This is perfect!
Thank you so much!

Happy to help, and thanks for the feedback