RANK.AVG Excel function inside MS Access

Question

I am trying to use Excel function RANK.AVG inside my MS ACCESS VBA code, but it gives me run-time error '1004'.

Here is my code:

Dim oExcel As Object
Set oExcel = CreateObject("excel.application")

For i = 0 To RowCount - 1
Arrfld4(i) = oExcel.Worksheetfunction.RANK.AVG(Arrfld1(i), Arrfld1())
Next i

Debug.Print vbNewLine

For i = 0 To RowCount - 1
    Debug.Print Arrfld4(i)
Next i

in Arrfld1() are those values:

 7 
 7 
 6 
 5 
 4 
 4 
 4 
 3 
 3 
 3 
 2 
 1 
 1 

And my expected result in Arrfld4() is:

 1,5 
 1,5 
 3 
 4 
 6 
 6 
 6 
 9 
 9 
 9 
 11 
 12,5 
 12,5

Answer 1

You can implement the ranking on an array yourself, though VBA offers little tools to work with arrays, so it'll require quite a bit of helper functions. The actual logic for ranking is noncomplex so easy to implement.

The main function:

Public Function Array_Rank(vArray As Variant, Optional SortArray = False) As Double()
    Dim vOut() As Double
    ReDim vOut(LBound(vArray) To UBound(vArray))
    If SortArray Then Array_Bubblesort vArray
    Dim l As Long
    Dim t As Variant
    For l = LBound(vArray) To UBound(vArray)
        t = Array_Positions(vArray(l), vArray)
        Array_Increment 1 - LBound(vArray), t
        vOut(l) = Array_Avg(t)
    Next
    Array_Rank = vOut
End Function

Helper functions:

Public Function Array_Positions(vKey As Variant, vArray As Variant) As Long()
    Dim out() As Long
    Dim l As Long
    Dim pos As Long
    For l = LBound(vArray) To UBound(vArray)
        If vArray(l) = vKey Then
            ReDim Preserve out(pos)
            out(pos) = l
            pos = pos + 1
        End If
    Next
    Array_Positions = out
End Function

Public Sub Array_Increment(vOffset As Variant, ByRef vArray As Variant)
    Dim l As Long
    For l = LBound(vArray) To UBound(vArray)
        vArray(l) = vArray(l) + vOffset
    Next
End Sub

Public Function Array_Sum(vArray As Variant) As Variant
    Dim l As Long
    For l = LBound(vArray) To UBound(vArray)
        Array_Sum = Array_Sum + vArray(l)
    Next
End Function

Public Function Array_Count(vArray As Variant) As Long
    On Error Resume Next 'Will error on uninitialized arrays, return 0 in that case
    Array_Count = UBound(vArray) - LBound(vArray) + 1
End Function

Public Function Array_Avg(vArray As Variant) As Variant
    Array_Avg = Array_Sum(vArray) / Array_Count(vArray)
End Function

Public Sub Array_Bubblesort(ByRef vArray As Variant)
    Dim l As Long
    Dim iter As Long
    iter = 1
    Dim hasSwapped As Boolean
    hasSwapped = True
    Dim t As Variant
    Do While hasSwapped And iter <= UBound(vArray) - LBound(vArray)
        hasSwapped = False
        For l = LBound(vArray) To UBound(vArray) - iter
            If vArray(l) > vArray(l + 1) Then
                t = vArray(l)
                vArray(l) = vArray(l + 1)
                vArray(l + 1) = t
                hasSwapped = True
            End If
        Next
        iter = iter + 1
    Loop
End Sub

Implementing it is as easy as:

Arrfld4 = Array_Rank(Arrfld1)

And you have your desired array.

Note that this is not made to perform optimally (mainly Array_Positionscould be rewritten to not require Redim Preserve), but it'll be faster than most other solutions if you have an array in memory.