Add 1 to Col B based on the rank of Col A values

[MrSpark]

I have problem may be someone could help. I have been using below code which add the Rank number to "ColB". This rank is based on that Rank number will be added to the highest value as 1 then to 2nd highest as 2 then 3rd highest as 3 and so on and last Rank number will be added to the value which is lowest in Rank.

Here is my code which is working perfectly but it does not skip the 0 . I want to skip the 0 that rank should not count 0 in "ColA".

Your help will be highly appreciated.

Here is attached Picture where it also includes the 0.

My code.

Sub WriteRanks()
    Dim Rng         As Range
    Dim Arr         As Variant
    Dim Ct          As Long
    Dim r           As Long

    Application.ScreenUpdating = False
    With Worksheets("Sheet1")
    
        Set Rng = .Range(.Cells(2, "A"), .Cells(.Rows.Count, "A").End(xlUp))
        Arr = Rng.Value
        For r = 1 To UBound(Arr)
        
            Arr(r, 1) = Arr(r, 1) + (r / (10 ^ 10))
        Next r
        
        With .UsedRange
            Ct = .Column + .Columns.Count
        End With
        Set Rng = Rng.Offset(0, Ct)
        Rng.Value = Arr
        
        For r = 1 To UBound(Arr)
            .Cells(r + 1, "B").Value = WorksheetFunction.Rank(Arr(r, 1), Rng, 0)
        Next r

        .Columns(Rng.Column).EntireColumn.Delete
    End With
    Application.ScreenUpdating = False
End Sub

 

[navic]

How about with a formula (Rank descending)

=IF($A2=0,"",IF(OR($A2>0,$A2<0),RANK($A2,$A$2:$A$30)))

Or (Rank ascending)

=IF($A2=0,"",IF($A2>0,RANK($A2,$A$2:$A$30,1)-COUNTIF($A$2:$A$30,0),RANK($A2,$A$2:$A$30,1)))

 

[MrSpark]

Hi thanks for the formula solution but looking to fix the problem through VBA.

navic​

 

[maabadi]

Try this code:

Sub Macro1()
Dim Lr As Long, Rng As Range
Lr = Range("A" & Rows.Count).End(xlUp).Row
Set Rng = Range("B2:B" & Lr)
Range("B2").FormulaR1C1 = "=IF(RC[-1]=0,"""",COUNTIFS(R2C1:R22C1,""<>""&0,R2C1:R22C1,"">""&RC[-1]) +IF(RC[-1]>0, 1,0))"
Range("B2").AutoFill Destination:=Rng
Rng.Value = Rng.Value
End Sub

 

[MrSpark]

Thank you

 

[maabadi]

You're Welcome & Thanks for Feedback.