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:

And my expected result in Arrfld4() is:

Erik A · Accepted Answer

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.

RANK.AVG Excel function inside MS Access

Answers (2)

Related Questions