Sort Data When a Header Is Clicked

[Rasm]

I have declared the variable 'HeaderRow' as a Public - so that is the row where I keep the Name(s) of the column header(s) - so now when I click any cell in the 'HeaderRow' the data below is sorted (like the property explorerbar in windows explorer) - It toggles between ascending and descending - however I have to set the focus to another cell (row different from HeaderRow) then click the same HeaderRow cell again - in order to toggke /ascending/descending - is there a way that I can click the same cell multiple times without going via another cell.

I picked this code up from somebody else - cannot remember his name - but it is very cool - so if I can fix this quirk it would be nice - but I have tried other events in the workbook - but none seems to do what I want.



Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Select Case Target.Row
Case HeaderRow
If IsEmpty(Target.Value) Then Exit Sub
Static MySortType As Integer
If MySortType = 0 Then
MySortType = xlAscending
ElseIf MySortType = xlAscending Then
MySortType = xlDescending
ElseIf MySortType = xlDescending Then
MySortType = xlAscending
End If
'Target.CurrentRegion.Offset(1).Sort key1:=Target, order1:=MySortType, Header:=xlYes
Target.CurrentRegion.Offset(0).Sort key1:=Target, order1:=MySortType, Header:=xlYes
End Select
End Sub

[littleiitin]

Try this:



Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim HeaderRow As Long
HeaderRow = Target.Row
Select Case Target.Row
Case HeaderRow
If IsEmpty(Target.Value) Then Exit Sub
Static MySortType As Integer
If MySortType = 0 Then
MySortType = xlAscending
ElseIf MySortType = xlAscending Then
MySortType = xlDescending
ElseIf MySortType = xlDescending Then
MySortType = xlAscending
End If
'Target.CurrentRegion.Offset(1).Sort key1:=Target, order1:=MySortType, Header:=xlYes
Target.CurrentRegion.Offset(0).Sort key1:=Target, order1:=MySortType, Header:=xlYes
End Select

End Sub





https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)

[Admin]

Hi,

This should work.


Const HeaderRow As Long = 4
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)

Cancel = True
If IsEmpty(Target.Value) Then Exit Sub
Static MySortType As Integer
If MySortType = 0 Then
MySortType = xlAscending
ElseIf MySortType = xlAscending Then
MySortType = xlDescending
ElseIf MySortType = xlDescending Then
MySortType = xlAscending
End If
'Target.CurrentRegion.Offset(1).Sort key1:=Target, order1:=MySortType, Header:=xlYes
Target.CurrentRegion.Offset(0).Sort key1:=Target, order1:=MySortType, Header:=xlYes

End Sub

Note: Code edited.

[Rasm]

Littleiitin
It behave similar - you have to leave the cell and then put focus on it again. so lets say my header row is row 4 - If I click cell B4 - the data is sorted ascending from row 5 and down - now - to sort descending - I have to click some other cell then click B4 again - I am tryinmg to avoid having to click the other cell.

[Rasm]

Admin
I have not tried yours yet - but I will. However I remembered the Calendar control example posted on this site - where you can right_click and the get the choices added. So using that code idea - this allow me to now right_click the HeaderRow and then sort ascending or descending. In this example my HeaderRow=4

Here is my problem - how can I pass the HeaderRow value from my worksheet code down to the sub(s) in module1 - I have hardwired that HeaderRow=4 in the subs in module1 - but I want to remove that line.

Is there a way I can pass the code residing in sheet1 - to any new sheets that I add - The code is passed if I copy a sheet - rather than adding a sheet - using the Excel GUI - But I would like to actually be ab;e to copy the worksheet code to any sheet of my choice. In a perfect world the worksheet code should reside in the workbook.

I have attached the XLSM file

Again - thank you Site mangers - this site is great.



Worksheet code


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
Dim HeaderRow As Long
HeaderRow = 4 'How to pass the variable to the sub sorting the dat
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 = 125
.OnAction = "SortAscending"
End With
With SortDescButton
.BeginGroup = True
.Style = msoButtonIconAndCaption
.Caption = "Sort Descending"
.FaceId = 125
.OnAction = "SortDesc"
End With
Set SortAsceButton = Nothing
Set SortDescButton = Nothing
On Error GoTo 0
End Sub
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
AddOnRightClick
End Sub



Module1 code



Sub SortDesc()
HeaderRow = 4 'This variable should be passed from worksheet code
Select Case ActiveCell.Row
Case HeaderRow
If IsEmpty(ActiveCell.Value) Then Exit Sub
Static MySortType As Integer
MySortType = xlDescending
'Target.CurrentRegion.Offset(1).Sort key1:=Target, order1:=MySortType, Header:=xlYes
ActiveCell.CurrentRegion.Offset(0).Sort key1:=ActiveCell, order1:=MySortType, Header:=xlYes
On Error Resume Next
Err.Clear
End Select
End Sub

Sub SortAscending()
HeaderRow = 4
Select Case ActiveCell.Row
Case HeaderRow
If IsEmpty(ActiveCell.Value) Then Exit Sub
Static MySortType As Integer
MySortType = xlAscending
'Target.CurrentRegion.Offset(1).Sort key1:=Target, order1:=MySortType, Header:=xlYes
ActiveCell.CurrentRegion.Offset(0).Sort key1:=ActiveCell, order1:=MySortType, Header:=xlYes
On Error Resume Next
Err.Clear
End Select
End Sub





https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)

[Excel Fox]

Remove ALL the macros in both the sheet, as well as in the modules. Copy the below code to ThisWorkbook module. You can now add any number of sheets, and the right-click controls will be available.

Also, the headerRow will now be available in the entire module, and just need to pass value to it in the AddOnRightClick() routine



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 'How to pass the variable to the sub sorting the dat
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 = 125
.OnAction = "ThisWorkbook.SortAscending"
End With
With SortDescButton
.BeginGroup = True
.Style = msoButtonIconAndCaption
.Caption = "Sort Descending"
.FaceId = 125
.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
'Target.CurrentRegion.Offset(1).Sort key1:=Target, order1:=MySortType, Header:=xlYes
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
'Target.CurrentRegion.Offset(1).Sort key1:=Target, order1:=MySortType, Header:=xlYes
ActiveCell.CurrentRegion.Offset(0).Sort key1:=ActiveCell, order1:=MySortType, Header:=xlYes
On Error Resume Next
Err.Clear
End Select

End Sub

[Rasm]

Perfect - exactly what the Doctor ordered - Thanks

Also use FaceId 3157 & 3158 - symbols for sorting

I uploaded the final XLSM files under tips-Tricks and downloads - this is a very usefull tool - Excel Fox & Admin - thanks for your help.

[fioramonti]

Hello Folks,
Maybe I am just having first time hickups to the site but where is data passed for the sort?

Or I am missing a point on this macro?

[Rasm]

Fioramonti

This routine sorts the entire sheet from the headerrow down -- are you looking to only sort a single column of data or a range of cells?

Rasm

[fioramonti]

Hello frasm,

Yes, I would be sorting a range of rows, single column.

Thanks

fioramonti