I am trying to sort 3 tables across 3 worksheets. I have made use of the Macro Recording tool and came up with these codes. However I can't get it running. Would highly appreciate any help given.
ps: How to do I post the codes properly in this forum? The code I posted below seems like a mess.
Sub SortTable_Click()
Dim sheetList
sheetList = Array("AAA", "BBB", "CCC")
Dim sheetName
For Each sheetName In sheetList
SortSheet ThisWorkbook.Sheets(sheetName)
Next sheetName
Sub SortSheet()
ActiveWorkbook.sheetName.AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.sheetName.AutoFilter.Sort.SortFields.Add2 _
Key:=Range("A3"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
With ActiveWorkbook.sheetName.AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
The code below includes procedures to call the sorter selected above. The original code is adapted but not changed (meaning it works in the same manner but no longer as a stand-alone, nor will the procedure in my above answer work with the code below. Paste the code below in a standard code module. Then follow the further instructions below its end.
Option Explicit
Const CmdName As String = "CmdSort" ' rename to suit
Const LbxName As String = "LbxSort"
Sub SortSelector()
' 126
' list tab names to be excluded from the list here, comma-separated
Const Excl As String = "Sheet17,Sheet25"
Const MaxHeight As Single = 330 ' adjust to suit
Const RowHeight As Single = 14.9 ' adjust to suit
' RowHeight may be different depending upon your default font
Dim Control As OLEObject
Dim Command As MSForms.CommandButton
Dim ListBox As MSForms.ListBox
Dim i As Integer ' loop counter: index
Dim n As Integer ' number of list entries
Dim Tmp As Variant
With ActiveSheet.OLEObjects
DeleteControls ' delete pre-existing
Set Control = .Add(ClassType:="Forms.ListBox.1", _
Link:=False, DisplayAsIcon:=False, _
Left:=200, Top:=40, _
Width:=100, Height:=RowHeight)
' manage Left, Top, Width and max Height here
End With
With Control
Set ListBox = .Object
With ListBox
.Name = LbxName
For i = 1 To Worksheets.Count
Tmp = Worksheets(i).Name
If InStr(1, "," & Excl & ",", "," & Tmp & ",", vbTextCompare) = 0 Then
.AddItem Tmp
n = n + 1
End If
Next i
If n Then
n = n + 1
.AddItem "All"
.MultiSelect = fmMultiSelectMulti
.BackColor = 13431551 ' change ListBox color here
Set Command = ActiveSheet.OLEObjects.Add( _
ClassType:="Forms.CommandButton.1", _
Link:=False, DisplayAsIcon:=False, _
Left:=Control.Left, Top:=Control.Top - 27, _
Width:=Control.Width, Height:=24).Object
With Command
.Name = CmdName
.Caption = "Sort now"
.BackColor = 9359529 ' change Button colour here
.Font.Bold = True
.TakeFocusOnClick = False
End With
End If
End With
End With
If n Then
Tmp = Application.WorksheetFunction.Min(n * RowHeight, MaxHeight)
Control.Height = Tmp
Control.Activate
With ListBox
.ListIndex = .ListCount - 1
.Selected(.ListIndex) = True
End With
End If
End Sub
Sub RunDeleteControls()
' 126
' use this procedure to delete stray controls created
' by this project and left behind in a crash
DeleteControls
End Sub
Sub DeleteControls(Optional ByVal Hide As Boolean)
' 126
' delete or hide pre-existing controls
' ==========================================================
' This procedure can also be run indepedent from this project
' (place the cursor in the sub 'RunDeleteControls` and press F5)
' ==========================================================
Dim Arr As Variant
Dim i As Long
Arr = Array(CmdName, LbxName)
With ActiveSheet.OLEObjects
On Error Resume Next
For i = 0 To UBound(Arr)
With .Item(Arr(i))
.Visible = False
If Not Hide Then .Delete
End With
Next i
End With
Err.Clear
End Sub
Sub SetTabSelection(Lbx As MSForms.ListBox)
' 126
Static Disabled As Boolean ' disable control events
Dim All As Integer ' ListIndex of "All" (0-based)
Dim i As Integer ' loop counter: ListIndex
Dim n As Integer
If Not Disabled Then
With Lbx
Disabled = True
All = .ListCount - 1
If .ListIndex = All Then
If .Selected(All) Then
For i = 0 To .ListCount - 2
.Selected(i) = False
Next i
End If
Else
For i = 0 To .ListCount - 2
n = n + .Selected(i)
Next i
If Abs(n) = All Then
For i = 0 To .ListCount - 2
.Selected(i) = False
Next i
End If
.Selected(All) = (Abs(n) = All)
End If
Disabled = False
End With
End If
End Sub
Sub SortSelectedTables(Lbx As MSForms.ListBox)
' 126
Dim TabList() As String
Dim All As Boolean
Dim n As Integer ' count of selected tabs
Dim i As Long ' loop counter: Lbx index
With Lbx
All = .Selected(.ListCount - 1)
ReDim TabList(1 To .ListCount)
For i = 0 To .ListCount - 2
If (.Selected(i) Or All) Then
n = n + 1
TabList(n) = .List(i)
End If
Next i
End With
If n Then
ReDim Preserve TabList(1 To n)
SortTables TabList
i = 0
Else
i = MsgBox("No worksheets were selected for sorting." & vbCr & _
"Exit without any action?", _
vbYesNo, "Cancel sorting")
End If
If i <> vbNo Then DeleteControls True
' Controls are only hidden at this point.
' They will be deleted when the tab is deactivated.
End Sub
Private Sub SortTables(TabList() As String)
' 126 - Nov 30, 2020
Dim i As Integer ' TbList index
Dim Tbl As ListObject ' loop object: Table
For i = LBound(TabList) To UBound(TabList)
On Error Resume Next
' an error will occur if the table doesn't exist
Set Tbl = Worksheets(TabList(i)).ListObjects(1)
If Err = 0 Then
On Error GoTo 0 ' stop on further errors
With Tbl.Sort
.SortFields.Clear
.SortFields.Add2 Key:=Tbl.DataBodyRange.Columns(1), _
SortOn:=xlSortOnValues, _
Order:=xlAscending, _
DataOption:=xlSortNormal
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End If
Next i
End Sub
To run this code run the procedure SortSelector
. Perhaps create a button for it or a shortcut. the code will create a list box on the ActiveSheet. The box lists all sheets in the workbook except those specified in the constant Const Excl As String = "Sheet17,Sheet25"
. Change the list to suit your needs. Avoid blanks that aren't part of a sheet name. You can also adjust the maximum size of the list box, its row height and, if you dive further into the code, control colours. Please read all comments.
You can select one, several, all or none of the sheets. Click on the Sort now button to sort the selected sheets. De-selecting all is paramount to Cancel. Unfortunately, all of the above is enabled only by the procedures below which must be pasted into the code module of the worksheet on which you want the action.
Private Sub CmdSort_Click()
' 126
SortSelectedTables LbxSort
End Sub
Private Sub LbxSort_Change()
' 126
SetTabSelection LbxSort
End Sub
Private Sub Worksheet_Deactivate()
' 126
DeleteControls
End Sub
The code is designed to act on the ActiveSheet
. Of course, that could be any sheet of your workbook. The 3 event procedures could be copied to the code modules of all the tabs in your workbook. If you do that you can use the feature on all the tabs in your workbook. If you leave some out, look for the procedure RunDeleteControls
in the standard code module which will remove the dysfunctional controls. They can also be deleted manually. Just remember, the controls created by SortSelector
will be animated by the 3 event procedures. Without them they will be unresponsive.
Finally, a word about why it took so long. In essence the code provides the functionality of a user form - without a user form and the extra clicks that entails. I have never programmed like that before, nor have I seen such work done by others. Please share your experience here.