Help: rewrite VBA function to accept array as argument

[alektherussian]

Hi guys,

I'm trying to use a custom function that we're supposed to use at work, but the problem is it doesn't accept array as argument (so I can't do ctrl+shift+enter).

This is a custom percentile function:

Function LPercentile(rArray As Variant, p1, Optional AtPosition As Boolean) As Variant
        
    Dim tArray() As Variant

    nvals = rArray.Cells.Count
    
    n = 0
    
    For Each nval In rArray.Cells
        If Application.WorksheetFunction.IsNumber(nval) = True And nval <> "" Then
            n = n + 1
            ReDim Preserve tArray(n)
            tArray(n) = Val(nval)
        End If
    Next nval
    
    If IsMissing(AtPosition) Then
        AtPosition = False
    End If
    
    If p1 <= 1 Then
            p1 = p1 * 100
    End If
    
    p2 = 100
    
    Ordinal = ((p1 * (n + 1)) / p2)
    
    If Not AtPosition Then
        Ordinal = Ordinal + kStart
    End If
    
    k = Int(Ordinal)
    r = Ordinal - k
    
    n = n + kStart
    
    If Not AtPosition Then
        a = Application.Large(tArray, n - (k - 1))
        b = Application.Large(tArray, n - k)
    Else
        a = tArray(k)
        b = tArray(k + 1)
    End If
    
   LPercentile = a + ((b - a) * r)
   
    
End Function

Could you help me rewrite it so that it accepts array as argument?
Your help is greatly appreciated!

 

[RoryA]

Try this:

Function LPercentile(rArray As Variant, p1, Optional AtPosition As Boolean = False) As Variant
    Dim tArray()              As Variant
    Dim vData
    Dim x                     As Long
    Dim y                     As Long

    If TypeName(rArray) = "Range" Then
        vData = rArray.Value2
    Else
        vData = rArray
    End If

    n = 0

    For x = LBound(vData, 1) To UBound(vData, 1)
        For y = LBound(vData, 2) To UBound(vData, 2)
            If IsNumeric(vData(x, y)) Then
                n = n + 1
                ReDim Preserve tArray(n)
                tArray(n) = CDbl(vData(x, y))
            End If
        Next y
    Next x

    If p1 <= 1 Then p1 = p1 * 100

    p2 = 100

    Ordinal = ((p1 * (n + 1)) / p2)

    If Not AtPosition Then Ordinal = Ordinal + kStart

    k = Int(Ordinal)
    r = Ordinal - k

    n = n + kStart

    If Not AtPosition Then
        a = Application.Large(tArray, n - (k - 1))
        b = Application.Large(tArray, n - k)
    Else
        a = tArray(k)
        b = tArray(k + 1)
    End If

    LPercentile = a + ((b - a) * r)


End Function

 

[alektherussian]

Try this:

Thank you RoryA! This is definitely an improvement, I don't get the value error anymore. Something still isn't quite right (or maybe it can't be right with the way the function is...). I'm attaching a link to an example in an xlsm format (your version of the function is embedded). https://app.box.com/s/<wbr>u7pm6myievjj6ryp0kxn (I don't see a way to attach files in this forum directly).

As you can see, when used in an array, the function doesn't produce the desired outcome. Any thoughts?

 

[RoryA]

Change the formula to:
=LPercentile(IF(B2:B25="NZ",A2:A25,""),0.5)

 

[alektherussian]

That makes sense! Thank you very much RoryA!