George Robinson
George Robinson

Reputation: 2125

How to UNIVERSALLY determine the number of elements in a 1D array?

How to write a function that will return the number of elements in any 1D array regardless of its data type ?

So far I have devised the following function:

Function ArrLen(ByRef arr As Variant) As Long
    If IsEmpty(arr) Then GoTo EmptyArr
    
        On Error GoTo EmptyArr
            ArrLen = UBound(arr) - LBound(arr) + 1
        Exit Function
EmptyArr:
        ArrLen = 0
End Function

I works with arrays of all built-in types, but it does not work with arrays of User-Defined Types.
Below are the contents of the entire VBA Module of a M.C.R. Example:

Option Explicit

Public Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Dim ArrOfIntegersN(1 To 6) As Integer
Dim ArrOfStringsN(0 To 4) As String
Dim ArrOfShapesN(1 To 4) As Shape
Dim ArrOfVariantsN(0 To 2) As Variant
Dim ArrOfRectsN(1 To 2) As RECT

Dim ArrOfIntegers() As Integer
Dim ArrOfStrings() As String
Dim ArrOfShapes() As Shape
Dim ArrOfVariants() As Variant
Dim ArrOfRects() As RECT


Sub main()
    Debug.Print ArrLen(ArrOfIntegersN) & " Integers"
    Debug.Print ArrLen(ArrOfStringsN) & " Strings"
    Debug.Print ArrLen(ArrOfShapesN) & " Shapes"
    Debug.Print ArrLen(ArrOfVariantsN) & " Variants"
    Debug.Print ArrLen(ArrOfRectsN) & " Rectangles"      'Error
    
    Debug.Print ArrLen(ArrOfIntegers) & " Integers"
    Debug.Print ArrLen(ArrOfStrings) & " Strings"
    Debug.Print ArrLen(ArrOfShapes) & " Shapes"
    Debug.Print ArrLen(ArrOfVariants) & " Variants"
    Debug.Print ArrLen(ArrOfRects) & " Rectangles"       'Error
    
    ReDim ArrOfIntegers(1 To 6)
    ReDim ArrOfStrings(0 To 4)
    ReDim ArrOfShapes(1 To 4)
    ReDim ArrOfVariants(0 To 2)
    ReDim ArrOfRects(1 To 2)                                 
    
    Debug.Print ArrLen(ArrOfIntegers) & " Integers"
    Debug.Print ArrLen(ArrOfStrings) & " Strings"
    Debug.Print ArrLen(ArrOfShapes) & " Shapes"
    Debug.Print ArrLen(ArrOfVariants) & " Variants"
    Debug.Print ArrLen(ArrOfRects) & " Rectangles"       'Error 
End Sub


Function ArrLen(ByRef arr As Variant) As Long
    If IsEmpty(arr) Then GoTo EmptyArr

        On Error GoTo EmptyArr
            ArrLen = UBound(arr) - LBound(arr) + 1
        Exit Function
EmptyArr:
        ArrLen = 0
End Function

The three errors that I am getting are occurring at the compilation time. The error messages are:

"Only user-defined types defined in public object modules can be coerced to or from a variant or passed to late-bound functions"

So, I am thinking: grrrrrr, it is some kind of silly VBA limitation, but then I analyze this error message in detail ...and notice that:

  1. The User-Defined Type Rect IS defined in a Public module !!!.
  2. The array of Rect is also declared as a Public global variable

Q1: Am I misunderstanding this error message somehow? How?
Q2: How to make the ArrLen() function universal so it can also accept arrays of User Defined Types (UDT) ?

Note: I am NOT interested in solutions that propose to use Classes in place of the User Defined Types, because I have no control of what Types are passed to my functions from a 3rd party code, which I cannot alter.

EDIT: This answer to another question indirectly answers Q1 by pointing out that Object Modules actually are Class Modules, however Q2 has been answered only by the member "Ambie" below.

Upvotes: 0

Views: 116

Answers (1)

Ambie
Ambie

Reputation: 4977

As noted in the comments, user-defined types must be defined in an Object Module to be passed as a variant to a function. It's a misleading phrase because an Object Module is actually a Class Module.

However, it is possible to read the element count of an array of UDTs defined in a Module (or any array for that matter). You would achieve this by reading the SAFEARRAY structure (https://learn.microsoft.com/en-us/windows/win32/api/oaidl/ns-oaidl-safearray) which you access from the array pointer rather than the array itself.

So you could pass the array pointer into your function and thereby avoid the problem of trying to coerce the array to a variant. If, as you say in your question, you are certain the array is only 1 dimension, then coding is relatively straightforward. Arrays of more than one dimension could be used but you'd need a little bit of pointer arithmetic (still pretty trivial, though) to get to the dimension you're after. Note that the code below assumes 64-bit:

Option Explicit

Private Declare PtrSafe Function GetPtrToArray Lib "VBE7" _
    Alias "VarPtr" (ByRef Var() As Any) As LongPtr

Private Declare PtrSafe Sub CopyMemory Lib "kernel32" _
    Alias "RtlMoveMemory" ( _
    ByRef Destination As Any, _
    ByRef Source As Any, _
    ByVal Length As Long)
    
Private Type SAFEARRAYBOUND
    cElements As Long
    lLbound As Long
End Type

Private Type SAFEARRAY_1D
    cDims As Integer
    fFeatures As Integer
    cbElements As Long
    cLocks As Long
    pvData As LongPtr
    rgsabound(0) As SAFEARRAYBOUND
End Type

Public Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Public Sub RunMe()
    Dim arrOfRects(0 To 5) As RECT
    Dim ptr As LongPtr
    Dim n As Long
    
    ptr = GetPtrToArray(arrOfRects)
    n = GetElementCount(ptr)
    Debug.Print n

End Sub

Private Function GetElementCount(arrPtr As LongPtr) As Long
    Dim saPtr As LongPtr
    Dim sa As SAFEARRAY_1D
    
    CopyMemory saPtr, ByVal arrPtr, 8
    CopyMemory sa, ByVal saPtr, LenB(sa)
    
    GetElementCount = sa.rgsabound(0).cElements
    
End Function

Upvotes: 3

Related Questions