VBA To Sort Rows With Multiple Columns In A Range On Cell Click Or Double Click

[G00DNESS]

I am using MS Windows Desktop and Excel 2019.

After my epic fail with trying the Data Filter/Allow Edit Ranges method for sorting a locked worksheet,
I need a VBA code for sorting to copy into 40 like-formatted worksheets within the same workbook.
On each worksheet, I would like to sort the Range B12:T511.
Both Range I12:I511 and Range Q12:Q511 are formula driven locked cells, and generate values.
I have no headers, but on click and/or double click on Row 11, I want the option to sort the rows within B12:T511
Row 11 are cells with only an arrow sign symbolizing that the column within the range is sortable.
If it is significant, G12:G511 are dates (MM/DD/YY), both I12:I511 and K12:K511 are currency.
There may be some blank cells within the range.

I want to avoid creating 360 sort buttons (9 on ea. 40 pages) because the file size is almost 2000kb without data entered.

I want the option to sort the entire range in both ascending and descending order (if possible):

On click/double click B11 >> Sort range based on B12:B511
On click/double click C11 >> Sort range based on C12:C511
On click/double click D11 >> Sort range based on D12:D511
On click/double click E11 >> Sort range based on E12:E511
On click/double click K11 >> Sort range based on K12:K511
On click/double click Q11 >> Sort range based on Q12:Q511
On click/double click R11 >> Sort range based on R12:R511
On click/double click S11 >> Sort range based on S12:S511
On click/double click T11 >> Sort range based on T12:T511

Thanks in advance for any help with a solution for this.

 

[mart37]

Place this by Microsoft Excel-Objects on every sheet:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim rngSort As Range
    Set rngSort = ActiveSheet.Range("B11:T11")
    If Not Intersect(Target, rngSort) Is Nothing Then
        Call SortTable(Target.Column)
    End If
End Sub

Place this in a module:

Sub SortTable(colno As Integer)
    Dim rngTable As Range
    Set rngTable = ActiveSheet.Range("B12:T511")
    firstrow = 12
    lastrow = 511
    ActiveSheet.Sort.SortFields.Clear
    ActiveSheet.Sort.SortFields.Add2 Key:=Range(Cells(firstrow, colno), Cells(lastrow, colno)) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveSheet.Sort
        .SetRange rngTable
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

 

[G00DNESS]

Place this by Microsoft Excel-Objects on every sheet:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim rngSort As Range
    Set rngSort = ActiveSheet.Range("B11:T11")
    If Not Intersect(Target, rngSort) Is Nothing Then
        Call SortTable(Target.Column)
    End If
End Sub

Place this in a module:

Sub SortTable(colno As Integer)
    Dim rngTable As Range
    Set rngTable = ActiveSheet.Range("B12:T511")
    firstrow = 12
    lastrow = 511
    ActiveSheet.Sort.SortFields.Clear
    ActiveSheet.Sort.SortFields.Add2 Key:=Range(Cells(firstrow, colno), Cells(lastrow, colno)) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveSheet.Sort
        .SetRange rngTable
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Thanks Mart37! Is it possible that this isn't working because Columns I and Q are locked and the Worksheet is protected? I have tried numerous solutions. None seem to work if the worksheet is locked.

 

[mart37]

If you by protection allow users to sort and select protected cells the macro is working.

 

[G00DNESS]

If you by protection allow users to sort and select protected cells the macro is working.

In the Review/Protect Menu, I did allow edit ranges. In the Protect Sheet options, I allowed sorting. I still can't get it to work when the sheet is protected.

 

[Tom.Jones]

@mart37,

Op want:

I want the option to sort the entire range in both ascending and descending order (if possible):

Your code sort only ascending.

 

[Tom.Jones]

@G00DNESS,

There may be some blank cells within the range.

That blank cells will gave you incorrect results after sorting.

 

[mart37]

With two directions:

Sub SortTable(colno As Integer)
    Dim rngTable As Range
    Dim rngSort As Range
    Dim S As Sort
    Dim SF As SortField
    Dim i As Long
    Dim SortOrder As Integer
    Application.ScreenUpdating = False
    Set rngTable = ActiveSheet.Range("B12:T511")
    Set S = ActiveSheet.Sort
    SortOrder = 1
    For i = 1 To S.SortFields.Count
        Set SF = S.SortFields(i)
        If colno = SF.Key.Column Then SortOrder = IIf(SF.Order = 1, 2, 1)
    Next
    firstrow = 12
    lastrow = 511
    ActiveSheet.Sort.SortFields.Clear
    ActiveSheet.Sort.SortFields.Add2 Key:=Range(Cells(firstrow, colno), Cells(lastrow, colno)) _
        , SortOn:=xlSortOnValues, Order:=SortOrder, DataOption:=xlSortNormal
    With ActiveSheet.Sort
        .SetRange rngTable
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Application.ScreenUpdating = True
End Sub