XLA routines: EE_SortCols

Nick's picture
EE_SortCols sorts columns by a predefined range of headers... Much quicker than rearranging cols yourself, and has the option to delete the cols that are not in your range.
Sub EE_SortCols(NewHeaders As range, Optional RangeToSort As range, Optional DeleteUnfoundCols As Boolean = False)
' sorts columns by the new sort order
' works if headers are in row 1
    Dim CantFindHeaderRow As Long
    Dim Header As Variant
    Dim i As Long
    Dim ColOrder As Long
 
'http://excelexperts.com/xla-routines-eesortcols for updates on this routine

    If RangeToSort Is Nothing Then
        Set RangeToSort = ActiveSheet.UsedRange
    End If
 
    CantFindHeaderRow = NewHeaders.Rows.Count + 1
    i = 1
 
    Dim NextAvailableCellRow As Long
    NextAvailableCellRow = EE_GetLastPopulatedCell(RangeToSort.Parent).Offset(1).Row
 
 
    For Each Header In EE_TableFirstRowRange(RangeToSort).value
 
        On Error Resume Next
        ColOrder = Application.WorksheetFunction.Match(Header, NewHeaders, 0)
        If Err.Number <> 0 Then
            ColOrder = 0
        End If
        Err.Clear: On Error GoTo 0: On Error GoTo -1
 
        If ColOrder = 0 Then
            If DeleteUnfoundCols Then
                RangeToSort.Parent.Columns(i).ClearContents
            End If
            RangeToSort.Parent.Cells(NextAvailableCellRow, i) = CantFindHeaderRow
            CantFindHeaderRow = CantFindHeaderRow + 1
        Else
            RangeToSort.Parent.Cells(NextAvailableCellRow, i) = ColOrder
        End If
        i = i + 1
    Next
 
    RangeToSort.Parent.Sort.SortFields.Clear
    RangeToSort.Parent.Sort.SortFields.Add Key:=EE_TableFirstRowRange(RangeToSort).Offset(NextAvailableCellRow - 1), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With RangeToSort.Parent.Sort
        .SetRange EE_RangeChange(RangeToSort, 0, 0, 1, 0)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlLeftToRight
        .SortMethod = xlPinYin
        .Apply
    End With
    EE_TableFirstRowRange(RangeToSort).Offset(NextAvailableCellRow - 1).ClearContents
End Sub