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

MrSpark

New Member
Joined
Mar 1, 2021
Messages
11
Office Version
  1. 2016
Platform
  1. Windows
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.
1619427444828.png


My code.

VBA 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
 

Excel Facts

Create a chart in one keystroke
Select the data and press Alt+F1 to insert a default chart. You can change the default chart to any chart type

navic

Active Member
Joined
Jun 14, 2015
Messages
333
Office Version
  1. 2013
Platform
  1. Windows
How about with a formula (Rank descending)
Code:
=IF($A2=0,"",IF(OR($A2>0,$A2<0),RANK($A2,$A$2:$A$30)))
Or (Rank ascending)
Code:
=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

New Member
Joined
Mar 1, 2021
Messages
11
Office Version
  1. 2016
Platform
  1. Windows
Hi thanks for the formula solution but looking to fix the problem through VBA.

navic

 

maabadi

Well-known Member
Joined
Oct 22, 2012
Messages
2,366
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
Try this code:
VBA 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
 
Solution

maabadi

Well-known Member
Joined
Oct 22, 2012
Messages
2,366
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
You're Welcome & Thanks for Feedback.
 

Forum statistics

Threads
1,141,402
Messages
5,706,224
Members
421,433
Latest member
yash0468

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top