VBA Code to Sort a list with column header activating the code

[Bobbbo]

I have a problem that I think is best solved with VBA code. I have a table (attached) that I want to sort by clicking the Year Date at the top of each column B6 through G6. I found this article https://trumpexcel.com/sort-data-vba/ but I can get it to do any thing adapting this code.

I have provide the results corrected sort from Largest to Smallest in Columns I through M with the cell I want to activate the code on a "click" in green just for clarity but the real table will have the dates all the same color. I also what to sort the "Unit" B column alphabetically.

[Logit]

.
The following will do what you are seeking EXCEPT for placing the MEDIAN row at the bottom of the table. Perhaps you can start with this
and determine the MEDIAN ROW issue after.

Please Login or Register  to view this content.

https://www.extendoffice.com/documen...r-to-sort.html

[Bobbbo]

Thanks for the help, this solution allows you to sort on any cell, which can make a real mess out of the whole table. And median cannot be included in the sort.

[Bobbbo]

Hi Logit, I found a solution to the "Median" row not being included in the sort. I I insert a row before the "Median" row, then hide the row. Median is no longer included in the sort.

[Logit]

.
Glad you found the answer.

If that solves your original question please mark this thread as SOLVED.

[Bobbbo]

Actually it does not as every cell can be sorted. Is there a way to restrict it to the header row only having the double click feature and no others?

[Logit]

.
Ok .. try this. It works here ...

Please Login or Register  to view this content.

[Marc L]

According to your attachment as a beginner starter :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 
    If Not Intersect([B6:G6], Target) Is Nothing Then 
        Cancel = True 
        [B6:G6].Interior.Color = vbYellow 
        [B7:G13].Sort Target(2), xlDescending + (Target.Column = 2), Header:=xlNo 
        If Target.Column > 2 Then Target.Interior.Color = vbGreen 
    End If 
End Sub  

Do you like it ? So thanks to click on bottom left star icon « ★ Add Reputation » !

[Marc L]

… the table is dynamic :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 
    With [B6].CurrentRegion.Rows 
        If Not Intersect(.Item(1), Target) Is Nothing Then 
            Cancel = True 
           .Item(1).Interior.Color = vbYellow 
           .Item("2:" & .Count - 1).Sort Target(2), 2 + (Target.Column = .Column), Header:=xlNo 
            If Target.Column > .Column Then Target.Interior.Color = vbGreen 
        End If 
    End With 
End Sub  

Do you like it ? So thanks to click on bottom left star icon « ★ Add Reputation » !

[Bobbbo]

Both Logit and Mar L,

Both your solutions work! Thanks so much!! How can I adapt either solution to sort the table in B6:G6 and also have the ability to sort additional tables such as I18:N18 as the actual project has multiple tables. I know I only asked for the B6:G6 to keep the question simple per the forums request, but I do need this additional twist of sorting multiple (2 or more) tables on the same Spreadsheet.

Thanks again!

[Marc L]

Thanks for the rep' !

In this case if you convert your ranges to real Excel tables it would be easier to detect
if any double click is within any headers row of any Excel table !

No need to convert if the worksheet contains only 'tables', of course attach a new sample workbook …

Do you prefer a green background or just a bold font for the sort header ?

[Bobbbo]

Thanks for the rep' !

In this case if you convert your ranges to real Excel tables it would be easier to detect
if any double click is within any headers row of any Excel table !

No need to convert if the worksheet contains only 'tables', of course attach a new sample workbook …

Do you prefer a green background or just a bold font for the sort header ?

I am not sure by your statement "real Excel Tables"? Actually I do like to colors, but Bold font would work well also.

Thanks, Bobbbo

[Marc L]

In your initial attachment there is no table, just ranges …
Attach at least a new sample workbook according to your new need.

[Marc L]

(removed as not a good idea)

[Bobbbo]

Great, now I understand. I have attached a sample closer to my final project. In the attached sample I need to sort on header Row 6 and Header Row 20. I added a blank ROW 15 and 29 to separate the median so it is not included in the sort and "Hide" that row.

If I convert these to "Tables" it automatically changes the header names in columns G through R because I used the same column names under each Metric which a table will not allow. That was the main reason I was looking for VBA code to do that sorting rather than with a Real Excel Table.

[Marc L]

According to your last attachment (edit) :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 
    With Target.CurrentRegion.Rows 
        If Not Intersect(.Item(2), Target) Is Nothing Then 
            Cancel = True 
           .Item(2).Font.Bold = False 
           .Item("3:" & .Count).Sort Target(2), 2 + (Target.Column = .Column), Header:=xlNo 
            Target.Font.Bold = True 
        End If 
    End With 
End Sub  

Do you like it ? So thanks to click on bottom left star icon « ★ Add Reputation » !

[Marc L]

See the code just edited in my previous post …

[Bobbbo]

Hi Marc, WOW it works great. Is there any way to have it toggle from descending to ascending as some of the metrics small is better and other larger is better.

[Marc L]

A toggle starter :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 
        Dim B As Boolean 
    With Target.CurrentRegion.Rows 
        If Not Intersect(.Item(2), Target) Is Nothing Then 
            Cancel = True 
            B = Target.Font.Bold 
           .Item(2).Font.Bold = False 
           .Item(2).Interior.ColorIndex = xlColorIndexNone 
           .Item("3:" & .Count).Sort Target(2), 1 - B, Header:=xlNo 
            Target.Font.Bold = Not B 
            If B Then Target.Interior.Color = vbYellow 
        End If 
    End With 
End Sub  

Do you like it ? So thanks to click on bottom left star icon « ★ Add Reputation » !

[Bobbbo]

Hi Marc, This code WORKS. Thanks so much. I will mark this solved. Great job.