Results 1 to 10 of 10

Thread: Sort Data When a Header Is Clicked

  1. #1
    Senior Member
    Join Date
    Apr 2011
    Posts
    190
    Rep Power
    14

    Sort Data When a Header Is Clicked

    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.

    Code:
    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
    xl2007 - Windows 7
    xl hates the 255 number

  2. #2
    Member littleiitin's Avatar
    Join Date
    Aug 2011
    Posts
    90
    Rep Power
    14
    Try this:
    Code:
    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
    Last edited by DocAElstein; 06-11-2023 at 01:22 PM.

  3. #3
    Administrator Admin's Avatar
    Join Date
    Mar 2011
    Posts
    1,123
    Rep Power
    10
    Hi,

    This should work.

    Code:
    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.
    Cheers !

    Excel Range to BBCode Table
    Use Social Networking Tools If You Like the Answers !

    Message to Cross Posters

    @ Home - Office 2010/2013/2016 on Win 10 (64 bit); @ Work - Office 2016 on Win 10 (64 bit)

  4. #4
    Senior Member
    Join Date
    Apr 2011
    Posts
    190
    Rep Power
    14
    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.
    xl2007 - Windows 7
    xl hates the 255 number

  5. #5
    Senior Member
    Join Date
    Apr 2011
    Posts
    190
    Rep Power
    14
    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
    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
    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
    Attached Files Attached Files
    Last edited by DocAElstein; 06-11-2023 at 01:22 PM.
    xl2007 - Windows 7
    xl hates the 255 number

  6. #6
    Administrator Excel Fox's Avatar
    Join Date
    Mar 2011
    Posts
    1,402
    Rep Power
    10
    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

    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 '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
    A dream is not something you see when you are asleep, but something you strive for when you are awake.

    It's usually a bad idea to say that something can't be done.

    The difference between dream and aim, is that one requires soundless sleep to see and the other requires sleepless efforts to achieve

    Join us at Facebook

  7. #7
    Senior Member
    Join Date
    Apr 2011
    Posts
    190
    Rep Power
    14
    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.
    Last edited by Rasm; 10-29-2011 at 06:25 PM.
    xl2007 - Windows 7
    xl hates the 255 number

  8. #8
    Junior Member
    Join Date
    Aug 2012
    Posts
    2
    Rep Power
    0

    Experience Vba co- New to this terrfic site - but cannot duplicate the sort procedure

    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?

  9. #9
    Senior Member
    Join Date
    Apr 2011
    Posts
    190
    Rep Power
    14
    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
    xl2007 - Windows 7
    xl hates the 255 number

  10. #10
    Junior Member
    Join Date
    Aug 2012
    Posts
    2
    Rep Power
    0

    Sorting in range

    Hello frasm,

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

    Thanks

    fioramonti

Similar Threads

  1. Sort Data Using Formula To Find Top X
    By mahmoud-lee in forum Excel Help
    Replies: 12
    Last Post: 06-02-2013, 10:13 PM
  2. Replies: 6
    Last Post: 05-10-2013, 01:13 AM
  3. Sort data sheet by right_click of mouse
    By Rasm in forum Excel and VBA Tips and Tricks
    Replies: 3
    Last Post: 12-08-2012, 07:34 PM
  4. Meger multiple file but header not same
    By rocky in forum Excel Help
    Replies: 14
    Last Post: 10-25-2012, 09:09 PM
  5. Excel Macro to Sort Data if a value changes in defined range
    By Rajesh Kr Joshi in forum Excel Help
    Replies: 4
    Last Post: 09-05-2012, 10:31 AM

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •