This code example was developed together with Excel Fox & the Admin of this site - thank you very much.
It allows you to sort data for the entire sheet (all columns) - starting (below) at a HeaderRow. So the entire sheet is sorted similar to how Windows explorer allow you to sort files by click on the ColumnHeader.
All you have to do is set the HeaderRow variable. In the attached XLSM file the HeaderRow =4
Simply right_click on the on a cell in the HeaderRow.
I thought this code could be of general interest.
Good luck coding -- Rasm
Workbook code
Code:
Option Explicit
Dim HeaderRow As Long
Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
AddOnRightClick
End Sub
Private Sub DeleteOnRightClick()
On Error Resume Next
With Application
.CommandBars("Cell").Controls("Sort Descending").Delete
.CommandBars("Cell").Controls("Sort Ascending").Delete
End With
On Error GoTo 0
End Sub
Private Sub AddOnRightClick()
On Error Resume Next
HeaderRow = 4 'You add code to set the header row
Dim SortAsceButton As CommandBarButton
Dim SortDescButton As CommandBarButton
With Application
.CommandBars("Cell").Controls("Sort Descending").Delete
Set SortDescButton = .CommandBars("Cell").Controls.Add(Temporary:=True, Before:=1)
End With
With Application
.CommandBars("Cell").Controls("Sort Ascending").Delete
Set SortAsceButton = .CommandBars("Cell").Controls.Add(Temporary:=True, Before:=1)
End With
With SortAsceButton
.BeginGroup = True
.Style = msoButtonIconAndCaption
.Caption = "Sort Ascending"
.FaceId = 3157
.OnAction = "ThisWorkbook.SortAscending"
End With
With SortDescButton
.BeginGroup = True
.Style = msoButtonIconAndCaption
.Caption = "Sort Descending"
.FaceId = 3158
.OnAction = "ThisWorkbook.SortDesc"
End With
Set SortAsceButton = Nothing
Set SortDescButton = Nothing
On Error GoTo 0
End Sub
Sub SortDesc()
Select Case ActiveCell.Row
Case HeaderRow
If IsEmpty(ActiveCell.Value) Then Exit Sub
Static MySortType As Integer
MySortType = xlDescending
ActiveCell.CurrentRegion.Offset(0).Sort key1:=ActiveCell, order1:=MySortType, Header:=xlYes
On Error Resume Next
Err.Clear
End Select
End Sub
Sub SortAscending()
Select Case ActiveCell.Row
Case HeaderRow
If IsEmpty(ActiveCell.Value) Then Exit Sub
Static MySortType As Integer
MySortType = xlAscending
ActiveCell.CurrentRegion.Offset(0).Sort key1:=ActiveCell, order1:=MySortType, Header:=xlYes
On Error Resume Next
Err.Clear
End Select
End Sub
Bookmarks