NMRRank_v2021

Ranks a number among set of numbers.
This is part of huge tool, we needed to substitute of Excel sheet function RANK, because RANK actually does not accept range that is not continues.
Means if you list of numbers are in two separate ranges, RANK will not help.
This Custom-made Excel function will exclude cells having certain value in certain column.

Similar to Rank, you can pass the order of rank

CodeFunctionName
What is this?

Public

Tested

Original Work

Function NMRRank_v2021(OfNumber, ForCol, Optional RankOrder = 1, Optional CompanyNameCol = "B", Optional InSheet = "CI Calc")
    ' Calculate Rank of range
    ' Because Rank() Excel formula does not accept 2 ranges, it only accepts one array to compare against
    ' And
    ' If we have TCA (in column "B" CompanyNameCol), we need to tell Rank to calculate around that row (ignoring the number of TCA)
    ' But at same time
    ' We need to keep the Rank of TCA to be calculated to give us its position among peers.
    '
    '        Original Excel formula        RANK(K2,K$2:K$86,0)
    '        =IF($B2="","",IF(OR(K2="N/A",),"",RANK(K2,K$2:K$86,0)))
    '
    Rett = ""
    MinRow = 2 ' 1st row of list to be ranked
    MaxRow = 86 ' last row of list
    If OfNumber = "" Then GoTo ByeBye
    If OfNumber = "N/A" Then
        Rett = "N/A"
        GoTo ByeBye
    End If
    ' Do we have TCA in "B" (CompanyNameCol) column
    TCAName = ShD.Range("EC124").Value ' TCA Company name
    TCAFound = MatchIf(TCAName, CompanyNameCol, , InSheet)
    Ref1 = ForCol & MinRow
    Ref2 = ForCol & TCAFound - 1
    Ref3 = ForCol & TCAFound + 1
    Ref4 = ForCol & MaxRow
    If TCAFound = 0 Then
        ' If we do not have TCA, use the built-in function RANK
        Rett = WorksheetFunction.Rank(OfNumber, Worksheets(InSheet).Range(Ref1, Ref4), RankOrder)
        GoTo ByeBye
    End If
    Rett = "#NMR"
    NMRRank_v2021 = Rett
    Dim Arra1()
    Dim Arra2()
    Dim Arra3()
    Arra1 = Worksheets(InSheet).Range(Ref1, Ref2).Value ' Generates 2-dim array
    Arra2 = Worksheets(InSheet).Range(Ref3, Ref4).Value
    Arra3 = merge2Arrays(Arra1, Arra2) ' Results in 1-dim array
    Arra3 = CleanArray(Arra3, 12)
    Arra3 = sortArray(Arra3, RankOrder)
    If OfNumber = Arra3(1) Then
        Rett = 1
    ElseIf OfNumber = Arra3(UBound(Arra3)) Then
        Rett = UBound(Arra3)
    Else
        For i = 1 To UBound(Arra3)
            If Arra3(i) = OfNumber Then
                Rett = i
                Exit For
            ElseIf RankOrder = 0 And i < UBound(Arra3) Then
                If Arra3(i) > OfNumber And Arra3(i + 1) < OfNumber Then
                    Rett = i
                    Exit For
                End If
            ElseIf RankOrder = 1 And i > 1 Then
                If Arra3(i) > OfNumber And Arra3(i - 1) < OfNumber Then
                    Rett = i
                    Exit For
                End If
            End If
        Next
    End If
   
ByeBye:
    NMRRank_v2021 = Rett
End Function

OfNumber, ForCol, Optional RankOrder = 1, Optional CompanyNameCol = "B", Optional InSheet = "CI Calc"

Views 332

Downloads 57

CodeID
DB ID