SortArea4

Sort range of cells by up to 4 columns.
Can use any of these columns, not necessarily all.
As always, pass range, sheet, workbook name and cell addresses of these byColumns and which order want to sort.

CodeFunctionName
What is this?

Public

Tested

Original Work
Sub SortArea4(Sorted_Range, SortByCell1, Optional SortCell1Order_Asc1_Desc2 = 1, _
    Optional SortByCell2 = "", Optional SortCell2Order_Asc1_Desc2 = 1, _
    Optional SortByCell3 = "", Optional SortCell3Order_Asc1_Desc2 = 1, _
    Optional SortByCell4 = "", Optional SortCell4Order_Asc1_Desc2 = 1, _
    Optional SheetName = "This", Optional WBName = "This")
    ' Sorted_Range is the actual area to be sorted, like A4:H200
    ' SoryByCell1 is the column to sort by, like B4
    If WBName = "This" Then WBName = ThisWorkbook.Name
    If SheetName = "This" Then SheetName = ActiveSheet.Name
    Workbooks(WBName).Worksheets(SheetName).Sort.SortFields.Clear
    Ord1 = xlAscending
    If SortCell1Order_Asc1_Desc2 = 2 Then Ord1 = xlDescending
    Workbooks(WBName).Worksheets(SheetName).Sort.SortFields.Add Key:=Workbooks(WBName).Worksheets(SheetName).Range(SortByCell1), _
        SortOn:=xlSortOnValues, Order:=Ord1, DataOption:=xlSortNormal
    If SortByCell2 > "" Then
        Ord2 = xlAscending
        If SortCell2Order_Asc1_Desc2 = 2 Then Ord2 = xlDescending
        Workbooks(WBName).Worksheets(SheetName).Sort.SortFields.Add Key:=Workbooks(WBName).Worksheets(SheetName).Range(SortByCell2), _
            SortOn:=xlSortOnValues, Order:=Ord2, DataOption:=xlSortNormal
    End If
    If SortByCell3 > "" Then
        Ord3 = xlAscending
        If SortCell3Order_Asc1_Desc2 = 2 Then Ord3 = xlDescending
        Workbooks(WBName).Worksheets(SheetName).Sort.SortFields.Add Key:=Workbooks(WBName).Worksheets(SheetName).Range(SortByCell3), _
            SortOn:=xlSortOnValues, Order:=Ord3, DataOption:=xlSortNormal
    End If
    If SortByCell4 > "" Then
        Ord4 = xlAscending
        If SortCell4Order_Asc1_Desc2 = 2 Then Ord4 = xlDescending
        Workbooks(WBName).Worksheets(SheetName).Sort.SortFields.Add Key:=Workbooks(WBName).Worksheets(SheetName).Range(SortByCell4), _
            SortOn:=xlSortOnValues, Order:=Ord4, DataOption:=xlSortNormal
    End If
    With Workbooks(WBName).Worksheets(SheetName).Sort
        .SetRange Workbooks(WBName).Worksheets(SheetName).Range(Sorted_Range)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Sorted_Range, SortByCell1, Optional SortCell1Order_Asc1_Desc2 = 1, _
    Optional SortByCell2 = "", Optional SortCell2Order_Asc1_Desc2 = 1, _
    Optional SortByCell3 = "", Optional SortCell3Order_Asc1_Desc2 = 1, _
    Optional SortByCell4 = "", Optional SortCell4Order_Asc1_Desc2 = 1, _
    Optional SheetName = "This", Optional WBName = "This"

Views 846

Downloads 62

CodeID
DB ID