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.
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
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"
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 837
Downloads 60
CodeID
DB ID