Sort different tables in different worksheets using VBA

[CBM2020]

Hi,

As usual I don't know where to start. I'm looking for VBA code to sort different tables (table name in below), but they are in different work sheets. I'd like to sort them in multiple columns.

Table_name Sheet_Name
tblMth01 Jan22
tblMth02 Feb22
tblMth03 Mar22
tblMth04 Apr22
tblMth05 May22
tblMth06 Jun22
tblMth07 Jul22
tblMth08 Aug22
tblMth09 Sep22
tblMth10 Oct22
tblMth11 Nov22
tblMth12 Dec22

Sorting criteria:
[PSM], then [Type], then [Client], then [Event], then [Date End].

Current code I've got and its now working as I wanted are:

Sub Sort_tblMth01()
'
Range("tblMth01").Select
Range("T19").Activate
ActiveWorkbook.Worksheets("oJan22").ListObjects("tblMth01").Sort.SortFields. _
Clear
ActiveWorkbook.Worksheets("oJan22").ListObjects("tblMth01").Sort.SortFields. _
Add2 Key:=Range("tblMth01[PSM]"), SortOn:=xlSortOnValues, Order:= _
xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("oJan22").ListObjects("tblMth01").Sort.SortFields. _
Add2 Key:=Range("tblMth01[Type]"), SortOn:=xlSortOnValues, Order:= _
xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("oJan22").ListObjects("tblMth01").Sort.SortFields. _
Add2 Key:=Range("tblMth01[Client]"), SortOn:=xlSortOnValues, Order:= _
xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("oJan22").ListObjects("tblMth01").Sort.SortFields. _
Add2 Key:=Range("tblMth01[Event]"), SortOn:=xlSortOnValues, Order:= _
xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("oJan22").ListObjects("tblMth01").Sort.SortFields. _
Add2 Key:=Range("tblMth01[Date End]"), SortOn:=xlSortOnValues, Order:= _
xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("oJan22").ListObjects("tblMth01").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

End Sub

Appreciate in advance!

 

[John_w]

Current code I've got and its now working as I wanted are:

Don't you mean it's NOT working?

Try this macro:

Public Sub Sort_Tables()

    Dim sheetsTables As Variant
    Dim i As Long
    
    sheetsTables = Split("Jan22 tblMth01 Feb22 tblMth02 Mar22 tblMth03 Apr22 tblMth04 May22 tblMth05 Jun22 tblMth06 Jul22 tblMth07 Aug22 tblMth08 Sep22 tblMth09 Oct22 tblMth10 Nov22 tblMth11 Dec22 tblMth12")

    For i = 0 To UBound(sheetsTables) Step 2
    
        With ActiveWorkbook.Worksheets(sheetsTables(i)).ListObjects(sheetsTables(i + 1)).Sort
            .SortFields.Clear
            .SortFields.Add2 Key:=Range(sheetsTables(i + 1) & "[PSM]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .SortFields.Add2 Key:=Range(sheetsTables(i + 1) & "[Type]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .SortFields.Add2 Key:=Range(sheetsTables(i + 1) & "[Client]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .SortFields.Add2 Key:=Range(sheetsTables(i + 1) & "[Event]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .SortFields.Add2 Key:=Range(sheetsTables(i + 1) & "[Date End]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    
    Next
    
End Sub

 

[CBM2020]

Yes, apologize for the typo. I meant to say my code doesn't work as I wanted. Thank you very much! Your one

Don't you mean it's NOT working?

Try this macro:

Public Sub Sort_Tables()

    Dim sheetsTables As Variant
    Dim i As Long
   
    sheetsTables = Split("Jan22 tblMth01 Feb22 tblMth02 Mar22 tblMth03 Apr22 tblMth04 May22 tblMth05 Jun22 tblMth06 Jul22 tblMth07 Aug22 tblMth08 Sep22 tblMth09 Oct22 tblMth10 Nov22 tblMth11 Dec22 tblMth12")

    For i = 0 To UBound(sheetsTables) Step 2
   
        With ActiveWorkbook.Worksheets(sheetsTables(i)).ListObjects(sheetsTables(i + 1)).Sort
            .SortFields.Clear
            .SortFields.Add2 Key:=Range(sheetsTables(i + 1) & "[PSM]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .SortFields.Add2 Key:=Range(sheetsTables(i + 1) & "[Type]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .SortFields.Add2 Key:=Range(sheetsTables(i + 1) & "[Client]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .SortFields.Add2 Key:=Range(sheetsTables(i + 1) & "[Event]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .SortFields.Add2 Key:=Range(sheetsTables(i + 1) & "[Date End]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
   
    Next
   
End Sub

Yes, sorry for the typo. Your code works perfectly. Cheers!

 

[CBM2020]

Hi John,

The code to sort multiple columns for multiple tables in multiple sheets it works perfectly.

Now after these actions, for each table above, I need to find the last row (an empty row) of all these tables and bring to the top row (first row after table header) using cut and paste. I tried few times and its not working.

Could you please help me again?

Many thanks in advance!

 

[John_w]

Try this:

    Dim table As ListObject

        Set table = ActiveWorkbook.Worksheets(sheetsTables(i)).ListObjects(sheetsTables(i + 1))
        With table
            .ListRows.Add 1
            .ListRows(.ListRows.Count).Range.Copy .ListRows(1).Range
            .ListRows(.ListRows.Count).Range.Delete
        End With

 

[CBM2020]

Hi John, I tried the below codes, but it shows in error "subscript out of range", how should I fix it?
Basically, after sorting all the tables with VBA. With the data I have, I will always have a empty line at the bottom of the table. I need to keep that empty line at the first row of the table after table header. Thank you hips!!

Sub Sort_tlbMth()

Dim sheetsTables As Variant
Dim i As Long

sheetsTables = Split("oJan22 tblMth01 oFeb22 tblMth02 oMar22 tblMth03 oApr22 tblMth04 oMay22 tblMth05 oJun22 tblMth06 oJul22 tblMth07 oAug22 tblMth08 oSep22 tblMth09 oOct22 tblMth10 oNov22 tblMth11 oDec22 tblMth12")

For i = 0 To UBound(sheetsTables) Step 2

With ActiveWorkbook.Worksheets(sheetsTables(i)).ListObjects(sheetsTables(i + 1)).Sort
.SortFields.Clear
.SortFields.Add2 Key:=Range(sheetsTables(i + 1) & "[PSM]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SortFields.Add2 Key:=Range(sheetsTables(i + 1) & "[Type]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SortFields.Add2 Key:=Range(sheetsTables(i + 1) & "[Client]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SortFields.Add2 Key:=Range(sheetsTables(i + 1) & "[Event]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SortFields.Add2 Key:=Range(sheetsTables(i + 1) & "[Date End]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

Next

Set sheetsTables = ActiveWorkbook.Worksheets(sheetsTables(i)).ListObjects(sheetsTables(i + 1))
With sheetsTables
.ListRows.Add 1
.ListRows(.ListRows.Count).Range.Copy .ListRows(1).Range
.ListRows(.ListRows.Count).Range.Delete
End With

End Sub

 

[Alex Blakenburg]

Since you are online now and I don't know what time zone John is in, put the new code @John_w has given you before the Next statement.
It is referencing "i" which is part of the For i = / Next loop and therefore needs to be inside the loop.

PS: Please use code tags when posting code so it can be easily read. (the easiest code tag for VBA is the VBA button)

 

[CBM2020]

Hi Alex,

It works now. @John_w Thank you very much! Greatly appreciated!