Macro to Sort one Specific Column in Ascending and another Specific Column in Descending then give Rank in another Specific Column

Dim RC As Long

Dim CC As Long

Dim Sort_Range As String

'To Get Column Index Number in Used Range(Eg: 1,2,3)

RC = ActiveSheet.UsedRange.Rows.Count

CC = ActiveSheet.UsedRange.Columns.Count

' To Get Column Index Name in Used Range(Eg: A,B,C..)

CN = Split(Cells(, CC).Address, "$")(1)

Sort_Range = "$A$1" & " : " & "$" & CN & "$" & RC

If ActiveSheet.Cells(1, X) = "Product Id" Then

S_1 = Cells(1, X).Column '? Sorting Column-1 Number(Eg: 1,2,3)

SC_1 = Split(Cells(, S_1).Address, "$")(1) '? Sorting Column-1 Index Name(Eg: A,B,C..)

ElseIf ActiveSheet.Cells(1, X) = "Sample" Then

S_2 = Cells(1, X).Column '? Sorting Column-2 Index Number(Eg: 1,2,3)

SC_2 = Split(Cells(, S_2).Address, "$")(1) '? Sorting Column-2 Index Name(Eg: A,B,C..)

ElseIf ActiveSheet.Cells(1, X) = "Rank" Then

RNK_C = Cells(1, X).Column '? Ranking Column Index Number(Eg: 1,2,3)

RNK_CN = Split(Cells(, S_2).Address, "$")(1) '? Ranking Column Index Name(Eg: A,B,C..)

End If

SC1_Range = "$" & SC_1 & "$1" & " : " & "$" & SC_1 & "$" & RC

SC2_Range = "$" & SC_2 & "$1" & " : " & "$" & SC_2 & "$" & RC

ActiveSheet.Range(Sort_Range).Select

ActiveSheet.Sort.SortFields.Clear

ActiveSheet.Sort.SortFields.Add Key:=Range(SC1_Range), _

SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

ActiveSheet.Sort.SortFields.Add Key:=Range(SC2_Range), _

SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal

.SetRange Range(Sort_Range)

.Header = xlYes

.MatchCase = False

.Orientation = xlTopToBottom

.SortMethod = xlPinYin

.Apply

X = 0

Y = 0

Z = 0

K = 0

If Cells(Y, S_1) <> Cells(X, S_1) Then Exit For

If (Cells(Y - 1, S_2) <> Cells(Y, S_2)) Then

Z = (Z + 1)

Cells(Y, RNK_C) = Z

K = K + 1

ElseIf (Cells(Y - 1, S_1) = Cells(Y, S_1)) And (Cells(Y - 1, S_2) = Cells(Y, S_2)) Then

Cells(Y, RNK_C) = Z

K = K + 1

Else

Z = Z + 1

Cells(Y, RNK_C) = Z

K = K + 1

End If

X = (X + K) - 1

Z = 0

K = 0

ActiveSheet.Range("$A$1").Select

MsgBox "Job Over", vbOKOnly, "Done"

Dim RC As Long

Dim CC As Long

Dim Sort_Range As String

On Error Resume Next

RC = ActiveSheet.UsedRange.Rows.Count

CC = ActiveSheet.UsedRange.Columns.Count 'To Get Column Index Number in Used Range

CN = Split(Cells(, CC).Address, "$")(1) ' To Get Column Index Name in Used Range

Sort_Range = "$A$1" & " : " & "$" & CN & "$" & RC

'Loop to Convert Each Column As a Named Range with Heading Name

For X = 1 To CC

If ActiveSheet.Cells(1, X) <> "" Then ActiveSheet.Cells(1, X).EntireColumn.Select

Selection.Name = Cells(1, X).Value

Next X

S_1 = ActiveSheet.Range("Gs_Id").Column ' ? Sorting Column-2 Number ?

S_2 = ActiveSheet.Range("Payout_Weight").Column ' ? Sorting Column-2 Number ?

RNK_C = ActiveSheet.Range("Rank").Column 'Ranking Column Number

ActiveSheet.Range(Sort_Range).Select

ActiveSheet.Sort.SortFields.Clear

ActiveSheet.Sort.SortFields.Add Key:=Range("Gs_Id"), _

SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

ActiveSheet.Sort.SortFields.Add Key:=Range("Payout_Weight"), _

SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal

With ActiveSheet.Sort

.SetRange Range(Sort_Range)

.Header = xlYes

.MatchCase = False

.Orientation = xlTopToBottom

.SortMethod = xlPinYin

.Apply

End With

X = 0

Y = 0

Z = 0

K = 0

If Cells(Y, S_1) <> Cells(X, S_1) Then Exit For

If (Cells(Y - 1, S_2) <> Cells(Y, S_2)) Then

Z = (Z + 1)

Cells(Y, RNK_C) = Z

K = K + 1

ElseIf (Cells(Y - 1, S_1) = Cells(Y, S_1)) And (Cells(Y - 1, S_2) = Cells(Y, S_2)) Then

Cells(Y, RNK_C) = Z

K = K + 1

Else

Z = Z + 1

Cells(Y, RNK_C) = Z

K = K + 1

End If

X = (X + K) - 1

Z = 0

K = 0

ActiveSheet.Range("$A$1").Select

MsgBox "Job Over", vbOKOnly, "Done"

**Model - I :****Sub Sort_Ascend_Descend_Rank()**Dim RC As Long

Dim CC As Long

Dim Sort_Range As String

'To Get Column Index Number in Used Range(Eg: 1,2,3)

RC = ActiveSheet.UsedRange.Rows.Count

CC = ActiveSheet.UsedRange.Columns.Count

' To Get Column Index Name in Used Range(Eg: A,B,C..)

CN = Split(Cells(, CC).Address, "$")(1)

Sort_Range = "$A$1" & " : " & "$" & CN & "$" & RC

**For X = 1 To CC**If ActiveSheet.Cells(1, X) = "Product Id" Then

S_1 = Cells(1, X).Column '? Sorting Column-1 Number(Eg: 1,2,3)

SC_1 = Split(Cells(, S_1).Address, "$")(1) '? Sorting Column-1 Index Name(Eg: A,B,C..)

ElseIf ActiveSheet.Cells(1, X) = "Sample" Then

S_2 = Cells(1, X).Column '? Sorting Column-2 Index Number(Eg: 1,2,3)

SC_2 = Split(Cells(, S_2).Address, "$")(1) '? Sorting Column-2 Index Name(Eg: A,B,C..)

ElseIf ActiveSheet.Cells(1, X) = "Rank" Then

RNK_C = Cells(1, X).Column '? Ranking Column Index Number(Eg: 1,2,3)

RNK_CN = Split(Cells(, S_2).Address, "$")(1) '? Ranking Column Index Name(Eg: A,B,C..)

End If

**Next X**SC1_Range = "$" & SC_1 & "$1" & " : " & "$" & SC_1 & "$" & RC

SC2_Range = "$" & SC_2 & "$1" & " : " & "$" & SC_2 & "$" & RC

ActiveSheet.Range(Sort_Range).Select

ActiveSheet.Sort.SortFields.Clear

ActiveSheet.Sort.SortFields.Add Key:=Range(SC1_Range), _

SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

ActiveSheet.Sort.SortFields.Add Key:=Range(SC2_Range), _

SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal

**With ActiveSheet.Sort**.SetRange Range(Sort_Range)

.Header = xlYes

.MatchCase = False

.Orientation = xlTopToBottom

.SortMethod = xlPinYin

.Apply

**End With**X = 0

Y = 0

Z = 0

K = 0

**For X = 2 To RC**'Total Rows in Used Range**For Y = X To RC**If Cells(Y, S_1) <> Cells(X, S_1) Then Exit For

If (Cells(Y - 1, S_2) <> Cells(Y, S_2)) Then

Z = (Z + 1)

Cells(Y, RNK_C) = Z

K = K + 1

ElseIf (Cells(Y - 1, S_1) = Cells(Y, S_1)) And (Cells(Y - 1, S_2) = Cells(Y, S_2)) Then

Cells(Y, RNK_C) = Z

K = K + 1

Else

Z = Z + 1

Cells(Y, RNK_C) = Z

K = K + 1

End If

**Next Y**X = (X + K) - 1

Z = 0

K = 0

**Next X**ActiveSheet.Range("$A$1").Select

MsgBox "Job Over", vbOKOnly, "Done"

**End Sub****----------------------------------------------------------------------------------------****Model - II :****Sub****Sort_Ascend_Descend_Rank****()**Dim RC As Long

Dim CC As Long

Dim Sort_Range As String

On Error Resume Next

RC = ActiveSheet.UsedRange.Rows.Count

CC = ActiveSheet.UsedRange.Columns.Count 'To Get Column Index Number in Used Range

CN = Split(Cells(, CC).Address, "$")(1) ' To Get Column Index Name in Used Range

Sort_Range = "$A$1" & " : " & "$" & CN & "$" & RC

'Loop to Convert Each Column As a Named Range with Heading Name

For X = 1 To CC

If ActiveSheet.Cells(1, X) <> "" Then ActiveSheet.Cells(1, X).EntireColumn.Select

Selection.Name = Cells(1, X).Value

Next X

S_1 = ActiveSheet.Range("Gs_Id").Column ' ? Sorting Column-2 Number ?

S_2 = ActiveSheet.Range("Payout_Weight").Column ' ? Sorting Column-2 Number ?

RNK_C = ActiveSheet.Range("Rank").Column 'Ranking Column Number

ActiveSheet.Range(Sort_Range).Select

ActiveSheet.Sort.SortFields.Clear

ActiveSheet.Sort.SortFields.Add Key:=Range("Gs_Id"), _

SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

ActiveSheet.Sort.SortFields.Add Key:=Range("Payout_Weight"), _

SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal

With ActiveSheet.Sort

.SetRange Range(Sort_Range)

.Header = xlYes

.MatchCase = False

.Orientation = xlTopToBottom

.SortMethod = xlPinYin

.Apply

End With

X = 0

Y = 0

Z = 0

K = 0

**For X = 2 To RC**'Total Rows in Used Range**For Y = X To RC**If Cells(Y, S_1) <> Cells(X, S_1) Then Exit For

If (Cells(Y - 1, S_2) <> Cells(Y, S_2)) Then

Z = (Z + 1)

Cells(Y, RNK_C) = Z

K = K + 1

ElseIf (Cells(Y - 1, S_1) = Cells(Y, S_1)) And (Cells(Y - 1, S_2) = Cells(Y, S_2)) Then

Cells(Y, RNK_C) = Z

K = K + 1

Else

Z = Z + 1

Cells(Y, RNK_C) = Z

K = K + 1

End If

**Next Y**X = (X + K) - 1

Z = 0

K = 0

**Next X**ActiveSheet.Range("$A$1").Select

MsgBox "Job Over", vbOKOnly, "Done"

**End Sub**
## No comments:

## Post a Comment