Sort data sheet by right_click of mouse

[Rasm]

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


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

[Admin]

Thanks Rasm.

[Rasm]

This modification will result in the right_click options for sorting is only shown when the HeaderRow has focus



Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
If Target.Row = HeaderRow Then
AddOnRightClick
Else
DeleteOnRightClick
End If
End Sub

[salman8200]

Really good