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

• 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 IfEnd Sub

Something along these lines may help you. The sort details are within the worksheet object, so I've used the range.worksheet relationship, but you could easily declare this as the sheet rather than using this way

Dim r As Excel.RangeDim s As SortDim sf As SortFieldSet r = Range("a1:c7")Set s = r.Worksheet.SortSet sf = s.SortFields.Add(Range("b1"), XlSortOn.xlSortOnValues, XlSortOrder.xlAscending)

I'm not too sure how you'd go about removing specific sorts though, may have to loop them and get the key as s.SortFields.Item(x).Delete uses an index number for x