XLA routines: EE_SortTable

Nick's picture
Sub routine that sorts a table using Excel 2007+ code. Needs to be extended to work with heading 2 and 3
Sub EE_SortTable(blnAscending As Boolean, wks As Worksheet, strFieldHeading As String)
'> - takes string of sheet name or wosksheet object, Heading1 string,
'> Ascending1 boolean... Optional Heading2 and 3.
'> - records active sheet
'> - selects target sheet
'> - finds the heading on the sheet
'> - assumes that heading row is 1st row of table
'> - creates a TableRange object that contains the data
'> - sorts the tableRange
'> - reselects the original sheet
    Dim rngTable        As range
    Dim rngSortData     As range
    Dim intHeaders      As Integer
    Dim intSort         As Integer
 
'http://excelexperts.com/xla-routines-eeSortTable for updates on this sub routine

    On Error Resume Next
        'Set rngTable = EE_Table(CStr(strFieldHeading(LBound(strFieldHeading))), wks)
        Set rngTable = EE_Table(strFieldHeading, wks)
    On Error GoTo 0
 
    If rngTable Is Nothing Then Exit Sub
 
    intSort = IIf(blnAscending, 1, 2)
 
    rngTable.Parent.Sort.SortFields.Clear
    'For intHeaders = LBound(strFieldHeading) To UBound(strFieldHeading)
        On Error GoTo ExitF
            'Set rngSortData = rngTable.Rows(1).Cells.Find(what:=CStr(strFieldHeading(intHeaders)), LookIn:=xlValues, LookAt:=xlWhole).Offset(1).Resize(rngTable.Rows.Count - 1)
            Set rngSortData = rngTable.Rows(1).Cells.Find(what:=strFieldHeading, LookIn:=xlValues, lookat:=xlWhole).Offset(1).Resize(rngTable.Rows.Count - 1)
        Err.Clear: On Error GoTo 0: On Error GoTo -1
        rngTable.Parent.Sort.SortFields.Add Key:=rngSortData, _
            SortOn:=xlSortOnValues, Order:=intSort, DataOption:=xlSortNormal
    'Next intHeaders
    
    With rngTable.Parent.Sort
        .SetRange rngTable
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
 
ExitF:
    Err.Clear: On Error GoTo 0: On Error GoTo -1
 
    Set rngTable = Nothing
    Set rngSortData = Nothing
End Sub