Sort different tables in different worksheets using VBA

CBM2020

New Member
Joined
May 30, 2022
Messages
6
Office Version
  1. 365
Platform
  1. Windows
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!
 

Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"
Current code I've got and its now working as I wanted are:
Don't you mean it's NOT working?

Try this macro:
VBA Code:
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
 
Upvote 0
Solution
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:
VBA Code:
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!
 
Upvote 0
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!
 
Upvote 0
Try this:
VBA Code:
    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
 
Upvote 0
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
 

Attachments

  • GPTR Capture.PNG
    GPTR Capture.PNG
    20.1 KB · Views: 4
Upvote 0
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)
 
Upvote 0

Forum statistics

Threads
1,213,522
Messages
6,114,112
Members
448,549
Latest member
brianhfield

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top