Using VBA to sort by multiple column headers - excel

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

Answer 1

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