Excel VBA sort by multiple criteria by successive clicking on a cell/text

Question

I'm trying to sort excel columns in a table based on clicked column header. So far, I have the code below and it works fine. I click on a header and the table is sorted by the column header that I clicked.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    If Not Intersect(ActiveCell, Range("active[#Headers]")) Is Nothing Then
        Dim KeyRange As Range
        Set KeyRange = Range(Target.Address)

        SortOrder = xlAscending

        If Target.Value = "price" Then
            SortOrder = xlDescending
        End If

        If Target.Value = "profit" Then
            SortOrder = xlDescending
        End If

        Range("active").Sort Key1:=KeyRange, Header:=xlYes, Order1:=SortOrder
    End If

End Sub

When I click on a different header cell, previous sort is canceled and new is set. And that's what I would like to change. I would like t add secondary sort criteria, instead of changing the primary.

I would like to sort by multiple criteria, just by successive clicking on different header cells. For example first sort by price, then by due date then by something else. This combination can be different, so I can't really use vba sort criteria 1,2,3 and do the sort all in one pass.

For clearing the sort order, I use this:

ActiveWorkbook.Worksheets("active").ListObjects("active").Sort.SortFields. _
    Clear

Do you have any ideas, how to achieve this?

Please do not ask me why I wrote the code the way it is written. I do not know. Unfortunately I'm not a coder, I roughly understand how the code works, but I do not have any deeper knowledge. I put this code together from different sources just by searching and then trying how it works (or more often how it doesn't work).

Answer 1

• You can improve your code by changing the use of Range in Range("active[#Headers]") and Range("active").Sort to the built-in properties and methods of a ListObject - ListObject.HeaderRowRange and ListObject.Sort.
• Select Case might be neater as well, instead of multiple If statements.
• Range(Target.Address) is redundant - you can just use Target.
• Adding a SortField will retain the existing sort options.

Making those changes, your code might look something like this:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim lObj As ListObject: Set lObj = Me.ListObjects("active")
    Dim SortOrder As Long

    If Not Intersect(Target, lObj.HeaderRowRange) Is Nothing Then
        Select Case Target.Value
            Case "Price", "Profit"
                SortOrder = xlDescending
            Case Else
                SortOrder = xlAscending
        End Select

        With lObj.Sort
            .SortFields.Add Key:=Target, SortOn:=xlSortOnValues, Order:=SortOrder
            .Apply
        End With
    End If

End Sub