Ranking a variant array with variable dimensions

Question

I'm doing VBA macros and need to use Arrays of values extensively. After the below help from @TonyDallimore on Stack Overflow, I've decided to use nested variant arrays.

VBA chrashes when trying to execute generated sub

I use multidimensional, jagged arrays to SELECT data from DB's and efficiently perform calculations and write to a Worksheet. The data is sometimes a single value (Rank:0) sometimes a row of values (Rank:1) sometimes a table of values with some cells containing rows of values (Rank:3). I use the function below to determine what kind of operations are possible and should be performed to such arrays.

This function, along with all my array related functions reside in a module: modCustomArrayFunctions.

'***************************************************************************'
'Returns the rank of the passed array                                       '
'Parameters:                                                                '
'   Arr: The array to be processed                                          '
'Returns:                                                                   '
'   The rank of the array                                                   '
'***************************************************************************'
Public Function Rank(ByRef Arr As Variant) As Byte
'Declarations **************************************************************'
Dim MaxRank As Byte     'Maximum rank of the elements of the array          '
Dim i As Integer
'***************************************************************************'
    If IsArray(Arr) Then
        If IsArrInitialized(Arr) Then
            MaxRank = 0
            For i = LBound(Arr) To UBound(Arr)
                Rank = Rank(Arr(i)) + 1
                If Rank > MaxRank Then MaxRank = Rank
            Next i
            Rank = MaxRank
        Else
            Rank = 0
        End If
    Else
        Rank = 0
    End If
End Function
'***************************************************************************'

I code my routines pretty much this way.

And the accompanying test is as follows:

'***************************************************************************'
Public Sub Rank_Test()
Dim TestArr As Variant
Dim TestRank As Integer
    'Test Non-Array
    If Rank(TestArr) = 0 Then
        Debug.Print "Non-Array OK"
    Else
        Debug.Print "Non-Array FAILED!"
    End If

    'Test Ranks 1 to 100
    For TestRank = 1 To 100
        TestArr = MakeArray(TestRank)
        If Rank(TestArr) = TestRank Then
            Debug.Print TestRank & "D OK"
        Else
            Debug.Print TestRank & "D FAILED!"
        End If
    Next TestRank
End Sub
'***************************************************************************'

Can the code, comments and test be deemed acceptable, what is there to improve? Is the test okay or have I got the whole unit testing idea wrong?

IsArrInitialized() and MakeArray(n) are listed for completeness here. Note that MakeArray(n) is only used to create test arrays and is private to the array test module.

'***************************************************************************'
Private Function MakeArray( _
    RankArr As Integer, _
    Optional Value As Variant = 1 _
) As Variant
Dim TestArr As Variant
Dim DummyArr As Variant
Dim i As Integer
    If RankArr = 0 Then
        MakeArray = Value
    ElseIf RankArr = 1 Then
        ReDim TestArr(1 To 1)
        TestArr(1) = Value
        MakeArray = TestArr
    Else
        ReDim TestArr(1 To 1)
        ReDim DummyArr(1 To 1)
        DummyArr(1) = Value
        For i = 1 To RankArr - 1
            DoEvents
            TestArr(1) = DummyArr
            DummyArr = TestArr
        Next i
        MakeArray = TestArr
    End If
End Function
'***************************************************************************'

---

'***************************************************************************'
'Determines if a dynamic array has been initialized                         '
'Parameters:                                                                '
'   Arr: The array to be processed                                          '
'Returns:                                                                   '
'   True if initialized, False if not                                       '
'***************************************************************************'
Public Function IsArrInitialized(ByRef Arr As Variant) As Boolean
'Declarations **************************************************************'
Dim dum As Long
'***************************************************************************'
    On Error GoTo ErrLine
    If IsArray(Arr) Then
        dum = LBound(Arr)
        If dum > UBound(Arr) Then
            GoTo ErrLine
        Else
            IsArrInitialized = True
        End If
    Else
        IsArrInitialized = False
    End If
Exit Function
ErrLine:
    IsArrInitialized = False
End Function
'***************************************************************************'

Answer 1

Regarding the not-listed IsArrInitialized, after investigating on StackOverflow, I ended up using this:

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
                               (pDst As Any, pSrc As Any, ByVal ByteLen As Long)

'returns true if specified array is initialized.
Public Function IsArrayInitialized(arr) As Boolean

  Dim memVal As Long

  CopyMemory memVal, ByVal VarPtr(arr) + 8, ByVal 4 'get pointer to array
  CopyMemory memVal, ByVal memVal, ByVal 4  'see if it points to an address...
  IsArrayInitialized = (memVal <> 0)        '...if it does, array is intialized

End Function

I would love to see your MakeArray implementation, but I'll stick to the Rank function.

Comments

'***************************************************************************'
'Returns the rank of the passed array                                       '
'Parameters:                                                                '
'   Arr: The array to be processed                                          '
'Returns:                                                                   '
'   The rank of the array                                                   '
'***************************************************************************'

I remember being told, in school, that this was a good way of documenting code. However, real-world experience has proven otherwise. These comments only clutter up the code, add to the burden of maintenance and inevitably become stale/obsolete/lies.

What's the need exactly? Say what the thing does. Good, useful comments don't do that - the code itself says "what", good comments say "why". How do you know what the thing does? With proper encapsulation and naming!

If the Rank function is defined in a code module called Helpers.bas that contains dozens of unrelated specialized functions like this, you have a problem. If it's defined in a code module called ArrayHelpers.bas that contains dozens of somewhat related specifalized functions like this, you have a lesser problem, but a problem still: in VBA anything Public declared in a code module (.bas) is accessible as a "macro" - a Public Function in Excel VBA could even be used as a cell formula, so naming is very important to avoid clashes with existing/"native" functions.

'Declarations **************************************************************'

Please don't. If you feel the need to "sectionize" the code inside a function, chances are that function is doing too many things.

Dim MaxRank As Byte     'Maximum rank of the elements of the array 

These comments shouldn't be needed; it should be clear what MaxRank is used for, and if it isn't, then the identifier needs a better name, not a comment.

---

Naming

I think Rank is a poor name for what the function does. First, I'm tempted to read it as a verb, but you intend it as a noun - nouns are generally classes (/objects), and verbs are for methods, functions and procedures.

Readability

Your function is recursive, and it's not clear what the intent is - arrays have indices, not "ranks" - the multiple assignments of the function's return value are also a hinderance, consider this:

Public Function Rank(ByRef Arr As Variant) As Byte
    Dim Result As Byte
    Dim MaxRank As Byte
    Dim i As Integer

    If IsArray(Arr) Then
        If IsArrInitialized(Arr) Then

            MaxRank = 0

            For i = LBound(Arr) To UBound(Arr)
                Result = Rank(Arr(i)) + 1 ' recursive call
                If Result > MaxRank Then MaxRank = Result
            Next i

            Result = MaxRank

        Else
            Result = 0
        End If
    Else
        Result = 0
    End If

    Rank = Result
End Function

The function's return value being only assigned once, makes it easier to rename it and easier to read and tell the reads from the writes and recursive calls at a glance.

Bug?

Unless you've specified Option Base 1 VBA arrays are 0-based, which means a return value of 0 could be problematic. Typical VBA code would return -1 for an invalid index, so you can tell an invalid index from a zero-based first index.

This, of course, is countered by explicitly declaring the lower bound of your arrays (1 to 1, 1 to 1, 1 to n), but that's a rather verbose way of declaring an array.

---

That said, I'm not 100% clear on exactly what that function is achieving, even after reading your SO post. Is it possible that you don't really need a multidimensional array (1,1,n), but rather a list of objects that encapsulate an array and two other fields? This code could be of interest.

Answer 2

From above:

you have a lesser problem, but a problem still: in VBA anything Public declared in a code module (.bas) is accessible as a "macro" - a Public Function in Excel VBA could even be used as a cell formula, so naming is very important to avoid clashes with existing/"native" functions.

To keep your internal public subs and functions from appearing in the user macro list, define them with an optional parameter, even though it is never used.

Public Sub YourName(Optional Dummy As Variant = Nothing)
    ' Your code goes here.
End Sub