Using VBA to rank a column and resolve tied numbers issues

[zaincmt]

Hi All,

Please could you assist me with the following code.

Function RankOverallTotal()

Set Ranklist = Range("T3:T50")

For Each Rcell In Ranklist
    Range(Rcell.Address).Offset(0, 1).Value = WorksheetFunction.Rank(Rcell.Value, Ranklist, 1) ' change 1 to 0 for desceending rank
Next Rcell

End Function

Basically the code works but when some of the totals match then the rank formula produces a tied number. So if 3 rows have a total of "5" in there column they will have the same rank. But then on the next ranked row it will skip the numerical order number by 2.

I basically need to use a similar ranked formula but I don't want the rank to skip numbers just because of tied numbers. So my table should end up looking like this.

[table="width: 500, class: grid, align: center"]
[tr]
[td]Total[/td]
[td]Rank[/td]
[/tr]
[tr]
[td]11[/td]
[td]1[/td]
[/tr]
[tr]
[td]11[/td]
[td]1[/td]
[/tr]
[tr]
[td]12[/td]
[td]2[/td]
[/tr]
[tr]
[td]13[/td]
[td]3[/td]
[/tr]
[tr]
[td]14[/td]
[td]4[/td]
[/tr]
[/table]

Thank you
GS

 

[Comfy]

This formula appears to work:

Excel 2010

	A	B
Total	Rank

<tbody>
[TD="align: center"]1[/TD]

[TD="align: center"]2[/TD]
[TD="align: right"]11[/TD]
[TD="align: right"]1[/TD]

[TD="align: center"]3[/TD]
[TD="align: right"]11[/TD]
[TD="align: right"]1[/TD]

[TD="align: center"]4[/TD]
[TD="align: right"]12[/TD]
[TD="align: right"]2[/TD]

[TD="align: center"]5[/TD]
[TD="align: right"]13[/TD]
[TD="align: right"]3[/TD]

[TD="align: center"]6[/TD]
[TD="align: right"]14[/TD]
[TD="align: right"]4[/TD]

</tbody>

Sheet1​

[TABLE="width: 85%"]
<tbody>[TR]
[TD]Worksheet Formulas[TABLE="width: 100%"]
<tbody>[TR="bgcolor: #DAE7F5"]
[TH]Cell[/TH]
[TH="align: left"]Formula[/TH]
[/TR]
[TR]
[TH="bgcolor: #DAE7F5"]B2[/TH]
[TD="align: left"]=SUMPRODUCT((A$2:A$6<a2< font="">)/COUNTIF(A$2:A$6,A$2:A$6&"")</a2<>)+1[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
</tbody>[/TABLE]

<rc[-1

Function RankOverallTotal(Order As String)
Set Ranklist = Range("A2:A6")
Ranklist.Offset(0, 1).FormulaR1C1 = "=SUMPRODUCT((R2C[-1]:R6C[-1]" & Order & "RC[-1])/COUNTIF(R2C[-1]:R6C[-1],R2C[-1]:R6C[-1]&""""))+1"
End Function

I added a parameter to the function so that you can set the rank to ascending or descending.</rc[-1

 

[Peter_SSs]

.. or if the Totals are already sorted as in your sample

Excel Workbook
	A	B
1	Total	Rank
2	11	1
3	11	1
4	12	2
5	13	3
6	14	4
7
Rank

 

[Comfy]

You would call the function like this:

Sub CallRank()
RankOverallTotal ">"
End Sub

 

[zaincmt]

Hey,

Thank you for your responses. I can't seem to get either codes to work however. I have 50 Rows and the totals aren't in numerical order. Plus to add to the issue I wouldn't be able to put a formula in a cell as its the totals come from a generated worksheet off of other VBA formulas.

I tried the below code but im not sure what to put as the Order String and how to make it cover all rows.

Function RankOverallTotal(Order As String)
Set Ranklist = Range("A2:A6")
Ranklist.Offset(0, 1).FormulaR1C1 = "=SUMPRODUCT((R2C[-1]:R6C[-1]" & Order & "RC[-1])/COUNTIF(R2C[-1]:R6C[-1],R2C[-1]:R6C[-1]&""""))+1"
End Function

Thank you again for your help.
GS

 

[zaincmt]

Hey,

I think ive managed to figure it out. Thank you. Ive used the below code that seems to work.

Function RankOverallTotal()

' "<" = Ascencding and ">" = descending order
Order = "<"

Set Ranklist = Range("T3:T50")
Ranklist.Offset(0, 1).FormulaR1C1 = "=SUMPRODUCT((R3C[-1]:R50C[-1]" & Order & "RC[-1])/COUNTIF(R3C[-1]:R50C[-1],R3C[-1]:R50C[-1]&""""))+1"

End Function

Thank you for your help.

Greatly appreciated <3