Using VBA to sort by multiple column headers

Question

I am looking to sort columns by header names since the column where the header is may change using VBA. I found the below code but couldnt figure out how to make it sort by more than one field. Basically i am looking to have this filter by KEY, Status, Enrolled on, Completed on in that order.

Dim sortAdd As String
Dim sortRange As Range

'Find which column "KEY" appears in
On Error GoTo err_chk
Rows("1:1").Find(What:="KEY", After:=Range("A1"), LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Activate
On Error GoTo 0
sortAdd = ActiveCell.Address(0, 0)

'Set sort range by using current region
Range("A1").CurrentRegion.Sort _
    key1:=Range(sortAdd), order1:=xlAscending, Header:=xlYes
    
Exit Sub
  'Error handling
err_chk:
If Err.Number = 91 Then
    MsgBox "No header row with title of KEY", vbOKOnly, "ERROR!"
Else
    MsgBox Err.Number & ": " & Err.Description
End If

Recorded macro seemed to work but not really ideal.

Range("Deduped[[#Headers],[Key]]").Select
ActiveWorkbook.Worksheets("Deduped").ListObjects("Deduped").sort.SortFields. _
    Clear
ActiveWorkbook.Worksheets("Deduped").ListObjects("Deduped").sort.SortFields. _
    Add2 Key:=Range("Deduped[Key]"), SortOn:=xlSortOnValues, Order:= _
    xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Deduped").ListObjects("Deduped").sort.SortFields. _
    Add2 Key:=Range("Deduped[HR Status]"), SortOn:=xlSortOnValues, Order:= _
    xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Deduped").ListObjects("Deduped").sort.SortFields. _
    Add2 Key:=Range("Deduped[Enrolled on Date]"), SortOn:=xlSortOnValues, _
    Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Deduped").ListObjects("Deduped").sort.SortFields. _
    Add2 Key:=Range("Deduped[Completion Date]"), SortOn:=xlSortOnValues, Order _
    :=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Deduped").ListObjects("Deduped").sort
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

user_9814069 · Answer

Sort On Multiple Columns

Option Explicit

Sub SortOnMultipleColumns()
    
    Dim SortHeaders As Variant
    SortHeaders = Array("KEY", "Status", "Enrolled on", "Completed")
    Dim SortOrders As Variant
    SortOrders = Array(xlAscending, xlAscending, xlAscending, xlAscending)
    
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    Dim srg As Range: Set srg = ws.Range("A1").CurrentRegion
    Dim shrg As Range: Set shrg = srg.Rows(1)
    
    Application.ScreenUpdating = False
    
    Dim ColumnIndex As Variant
    Dim n As Long
    
    For n = LBound(SortHeaders) To UBound(SortHeaders)
        ColumnIndex = Application.Match(SortHeaders(n), shrg, 0)
        If IsNumeric(ColumnIndex) Then
            srg.Sort srg.Columns(ColumnIndex), SortOrders(n), , , , , , xlYes
        Else
            MsgBox "Could not find the header '" & SortHeaders(n) & "'.", _
                vbCritical
        End If
    Next n
    
    Application.ScreenUpdating = True
    
End Sub

Using VBA to sort by multiple column headers

1 Answers

Sort On Multiple Columns