Cross posted at:
https://www.mrexcel.com/forum/excel-...mbers-vba.html

Reason:
No response after three days

I want to set some numbers as system numbers to use against the ranking as done by the code below. Currently, I am using three numbers – 100, 95 and 90. In the future, I may reduce (say 2 numbers) or increase (say 5 or more numbers). And in each scenario, the aim is to make those numbers take the top-most ranks, should those numbers fail to appear in my data as I define the rules below. So these are the rules:
1. 100 is always ranked first. Which means that if there is no 100 in my data, then the highest number in my data is second but not first and run for numbers from 99 to 95 in my data
2. If there are no numbers from 99 to 95 in my data, then 95 is ranked second into the system, then numbers from 94 to 91 take from 4th downwards. But if there are say 98 and 96 in my data, then after systematically using the first rank for 100(system number), then we have 2nd for 98 and 3rd for 96. In this case, the next system number, 95, which by default was supposed to be 2nd, will now shift to the 4th rank. So here, the rank shift as there are more numbers in between.
3. If the highest ranked number in the point 2 above is 2nd, then, we assign 3rd to our system number 90. But if that is different, say 3rd, 4th etc, then we make the rank shift as described in point 2 above.


Sample of how I want my output look like

==================
Number        Rank
==================
98        2nd
96        3nd
94        5th
93        6th
70        8th 
=================
From the above, since there were no 100, 95 and 90 in my data, those ranks were absorbed by the system, 1st for 100, 4th for 95 and 7th for 90.


Thanks so much for your time and effort to help me out.


Sub RankDynamic()
     Dim dicSection As Object, vItem As Variant, wsData As Worksheet, vSection As Variant, rScore As Range, _
     rCell As Range, Score As Variant, Rnk As Double, LastRow&, iCol&
     Application.ScreenUpdating = False
     
     Set wsData = Sheets("Sheet1")
    With wsData
        If .FilterMode Then .ShowAllData
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
     End With
     
    If LastRow > 1 Then
         'Data exists
    Else
        MsgBox "No data exists!", vbExclamation
        Exit Sub
    End If
    
    On Error Resume Next
    Set dicSection = CreateObject("Scripting.Dictionary")
    dicSection.CompareMode = 1 'vbTextCompare
    vSection = wsData.Range("C6:C" & LastRow).Value
    For i = LBound(vSection) + 1 To UBound(vSection)
        If Not dicSection.Exists(vSection(i, 1)) Then
            dicSection(vSection(i, 1)) = ""
        End If
     Next i
For Each vItem In dicSection.keys()
    With wsData.UsedRange
    .AutoFilter field:=3, Criteria1:=vItem
    
    Set rScore = .Offset(1, 1).Resize(.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible)
    For i = 2 To 12
        For Each rCell In rScore.Offset(, i)
        Score = rCell.Value
            If Application.IsNumber(Score) Then
                Rnk = WorksheetFunction.Rank(CDbl(Score), rScore.Offset(, i))
                rCell.Offset(, 12).Value = Rnk & GetOrdinalSuffixForRank(Rnk)
            End If
        Next rCell
    Next i
        .AutoFilter
    End With
    Next vItem
    Application.ScreenUpdating = True
    
    Set dicSection = Nothing
    Set rScore = Nothing
    Set rCell = Nothing
End Sub


Function GetOrdinalSuffixForRank(Rnk As Double) As String
 Dim sSuffix$
If Rnk Mod 100 >= 11 And Rnk Mod 100 <= 20 Then
    sSuffix = " TH"
Else
    Select Case (Rnk Mod 10)
        Case 1: sSuffix = " ST"
        Case 2: sSuffix = " ND"
        Case 3: sSuffix = " RD"
        Case Else: sSuffix = " TH"
    End Select
End If
     GetOrdinalSuffixForRank = sSuffix
End Function