SortArea5

Sort range or area by 5 columns, range can be any number of columns, but the order by can be up to 5 columns, options to control what range to sort, by what column, and what order in addition to sheet and workbook.

Sub SortArea5(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 SortByCell5 = "", Optional SortCell5Order_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
 If SortByCell5 > "" Then
  Ord5 = xlAscending
  If SortCell5Order_Asc1_Desc2 = 2 Then Ord5 = xlDescending
  Workbooks(WBName).Worksheets(SheetName).Sort.SortFields.Add Key:=Workbooks(WBName).Worksheets(SheetName).Range(SortByCell5), _
   SortOn:=xlSortOnValues, Order:=Ord5, 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

Parameters

Sorted_Range, SortByCell1 through SortByCell5, SortCell1Order_Asc1_Desc2 through SortCell5Order_Asc1_Desc2,
SheetName, WBName

Views 115 Downloads 54

Perm link