Need a general purpose Excel VBA method for sorting tables

Question

Lately i have been doing a fair amount of work sorting Excel tables and was looking for an Excel VBA method to generalize that task. It needed to be simple and easy to use.

Answer 1

Here is what I came up with:

Public Function SortExcelTable(ExcelTable As ListObject, ParamArray SortRanges() As Variant) As Boolean

The ParamArray handles column numbers, headings or a mixture of the two and can be interspersed with True or False as needed for Ascending or Descending. To make data validation easier, a RangeToDictionary helper method is used. It creates a Case Insensitive dictionary of all of the column headers and is called with ExcelTable.HeaderRowRange. Late binding is used with the Dictionary objects to avoid needing a reference to Microsoft Scripting Runtime.

Public Function RangeToDictionary(Source As Range, _
                                  Optional CaseInsensitive As Boolean = True) As Object ' Scripting.Dictionary
Dim oCell As Range
Dim oDictionary As Object ' Scripting.Dictionary
    ''Set oDictionary = New Scripting.Dictionary
    Set oDictionary = CreateObject("Scripting.Dictionary")
    If CaseInsensitive Then
        oDictionary.CompareMode = TextCompare
    End If
    For Each oCell In Source
        ''Debug.Print oCell.Value
        Call oDictionary.Add(oCell.Value, Nothing)
    Next
    
    Set RangeToDictionary = oDictionary
    Set oCell = Nothing: Set oDictionary = Nothing
End Function

The main function 1.) Validates the incoming ParamArray and converts any column numbers into their corresponding header. This allows validation against the dictionary created by the helper method mentioned above. It then 2.) Spins through the ParamArray again and creates the actual SortFields used in the sort.

A small point of interest is the use of a Dictionary to hold the Range references needed for the SortFields. This technique allows for a varying number of range objects depending upon the ParamArray.

Public Function SortExcelTable(ExcelTable As ListObject, _
                               ParamArray SortRanges() As Variant) As Boolean
On Error GoTo ErrorHandler
Dim oDictionary As Object ' Scripting.Dictionary
Dim eSortOrder As XlSortOrder
Dim lIndex As Long
Dim sRange As String
Dim vItem As Variant
    If UBound(SortRanges) = -1 Then
        Call Err.Raise(vbObjectError + 1, "SortExcelTable", "No sort columns(s) specified.")
    End If
    
    ' Create dictionary of column headers.
    Set oDictionary = RangeToDictionary(ExcelTable.HeaderRowRange)
    
    ' Validate column values.
    For lIndex = LBound(SortRanges) To UBound(SortRanges)
        If Not TypeName(SortRanges(lIndex)) = "Boolean" Then
            ' Convert column numbers to column headers.
            If IsNumeric(SortRanges(lIndex)) Then
                SortRanges(lIndex) = ExcelTable.HeaderRowRange.Item(SortRanges(lIndex))
            End If
            
            ' Validate the column header.
            If Not oDictionary.Exists(SortRanges(lIndex)) Then
                Call Err.Raise(vbObjectError + 2, "SortExcelTable", "Invalid sort column: '" & SortRanges(lIndex) & "'.")
            End If
        End If
    Next

    ''Set oDictionary = New Scripting.Dictionary
    Set oDictionary = CreateObject("Scripting.Dictionary")
    
    With ExcelTable.Sort
       .SortFields.Clear
       
        For lIndex = LBound(SortRanges) To UBound(SortRanges)
            If TypeName(SortRanges(lIndex)) = "String" Then
                ' Default to ascending but check to see if next param array value is a boolean.
                eSortOrder = xlAscending
                If lIndex < UBound(SortRanges) Then
                    If TypeName(SortRanges(lIndex + 1)) = "Boolean" Then
                        eSortOrder = IIf(SortRanges(lIndex + 1), xlAscending, xlDescending)
                    End If
                End If
                
                ' Use dictionary so any number of sort columns can be handled.
                sRange = ExcelTable.Name & "[" & SortRanges(lIndex) & "]"
                Call oDictionary.Add(sRange, Range(sRange))
               .SortFields.Add Key:=oDictionary.Item(sRange), SortOn:=xlSortOnValues, Order:=eSortOrder
                ''Debug.Print sRange; "  "; IIf(eSortOrder = xlAscending, "xlAscending", "xlDescending")
            End If
        Next
       
       .Header = xlYes
       .Apply
    End With
    
ErrorHandler:
    SortExcelTable = (Err.Number = 0)
    
    ' Not sure if this step is actually needed.
    For Each vItem In oDictionary.Items
        If TypeName(vItem) = "Range" Then
            Set vItem = Nothing
        End If
    Next
    Set oDictionary = Nothing
On Error GoTo 0
End Function

Here are some sample usages.

Private Sub TestSort()
    ' Missing paramarray.   
    Call SortExcelTable(SystemConfiguration.ListObjects.Item(1))
    ' Invalid column header.
    Call SortExcelTable(SystemConfiguration.ListObjects.Item(1), "Hello World!")
    ' Column numbers.
    Call SortExcelTable(SystemConfiguration.ListObjects.Item(1), 2, False, 3)
    ' Mixed column headers and numbers.
    Call SortExcelTable(SystemConfiguration.ListObjects.Item(1), "Include Sheet", False, 3)
    ' Column headers.
    Call SortExcelTable(SystemConfiguration.ListObjects.Item(1), "Include Sheet", False, "Sheet Sequence")
    Call SortExcelTable(SystemConfiguration.ListObjects.Item(1), "Orig Row")
End Sub

Enjoy...