Try this Macro
Sub Macro1()
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("E2:E13") _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
.SetRange Range("A1:F13")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("F2:F13").FormulaR1C1 = _
"=IF(AND(RC[-1]<>R[-1]C[-1],RC[-1]<>R[1]C[-1]),0,IF(RC[-1]<>R[-1]C[-1],0,R[-1]C+1))"
Range("F2:F13").Value = Range("F2:F13").value
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("E2:E13") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
.SetRange Range("A1:F13")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A2").Select
End Sub
This can be reduced to:
Sub Macro2()
Range("A1:F13").Sort Key1:=Range("E2:E13"), _
Order1:=xlDescending, Header:=xlYes, MatchCase:=False, _
Orientation:=xlTopToBottom
Range("F2:F13").FormulaR1C1 = _
"=IF(AND(RC[-1]<>R[-1]C[-1],RC[-1]<>R[1]C[-1]),0,IF(RC[-1]<>R[-1]C[-1],1,R[-1]C+1))"
Range("F2:F13").Value = Range("F2:F13").Value
Range("A1:F13").Sort Key1:=Range("E2:E13"), _
Order1:=xlAscending, Header:=xlYes, MatchCase:=False, _
Orientation:=xlTopToBottom
Range("A2").Select
End Sub
Bookmarks