Ranking with VBA - no gaps between ranks

[xogregor]

I have a problem ranking a large dataset(more than 30000 rows, 16 different columns need to be ranked). My problem is that I dont want the ranks to have gaps when there are ties.
See how it should be in table below.

Ext P$	Rank	Should be
2,128.34	1	1
2,128.34	1	1
1,023.78	3	2
822.72	4	3

<tbody>
</tbody>

I do have a working solution with an array formula similar to this, but it slows down my macro (30 minutes instead of 10 seconds) as I need it to calculate 16 times

=SUM(1/COUNTIF(A$2:A$35000;A$2:A$35000)*(A$2:A$35000>A2))+1

I was thinking of using a for next loop to rank sorted columns but I dont know how to set it up properly. Maybe someone here can help, it would be greatly appreciated


Thanks

 

[JoeMo]

Here's an example for values in column A with a header in A1 that includes a sort.

Sub RankNoGaps()
Dim lR As Long, c As Range, ct As Long
lR = Range("A" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = false
Range("A2").Sort key1:=[A2], order1:=xlDescending, Header:=xlYes
Range("B1").Value = "Rank"
ct = 1
For Each c In Range("A2:A" & lR)
    If c.Row = 2 Then
        c.Offset(0, 1).Value = 1
    ElseIf c.Value = c.Offset(-1, 0).Value Then
        c.Offset(0, 1).Value = c.Offset(-1, 1).Value
    Else
        ct = ct + 1
        c.Offset(0, 1).Value = ct
    End If
Next c
Application.ScreenUpdating = True
End Sub

 

[xogregor]

Amazing, thanks! One follow-up question though: How would I change the code to work on multiple columns, I havent used offset often, so not a 100% sure how I would do it exactly. Simplified example of data setup below

Ext P$	Ext P$	Ext P$	Rank1	Rank2	Rank3
2,128.34	1,583.89	2,004.63
2,128.34	1,898.95	1,998.97
1,023.78	2,054.17	865.27
822.72	1,645.45	1,837.42
782.64	782.64	347.84

<colgroup><col><col span="5"></colgroup><tbody>
</tbody>

 

[xogregor]

Actually, nevermind, I figured it out myself!
Thanks a lot for the help!