VB Snippet - Determine if Array is Empty

VB Code:

Private Function isArrayEmpty(arr as Variant) As Boolean
 
 Dim dblCount As Double
 
 isArrayEmpty = True 
 
 On Error Resume Next 
 
' CAUSES AN ERROR IF EMPTY
 
 dblCount = Ubound(arr) 
 
 If Err.Number > 0 Then Exit Function 
 
 isArrayEmpty = False 
 
End Function

Suggestion - change your Subject to something like "Determine if array is empty" since that's what the code is doing. Your current subject implies that it returns the number of array elements and it doesn't.

I know that this is the old topic, but I think this code will be useful to quickly determine if array is not initialized:
Fastest method:

VB Code:

Dim a() As Long
If SAPtr(a) = 0 Then
  MsgBox "Not initialized"
Else
  MsgBox "Initialized"
End If

SAPtr it is TLB-declared function:

С Code:

[entry("GetMem4")]
        HRESULT __stdcall SAPtr(
            [in]            SAFEARRAY(void) *   Array,
            [out, retval]   long *              lpRetVal
        );

You can find the Type Library in the my last topics...

Not so fast, but very easy method:

VB Code:

Dim a() As Long
If (Not a) = -1 Then
  MsgBox "Not initialized"
Else
  MsgBox "Initialized"
End If

and with the same speed:

VB Code:

Dim a() As Long
If (Not Not a) = 0 Then
  MsgBox "Not initialized"
Else
  MsgBox "Initialized"
End If

if (not arr) = -1 then

seems duplicated

Here's what I've used for years:

Code:

---


Option Explicit
'
Private Declare Function GetMem2 Lib "msvbvm60" (ByRef Source As Any, ByRef Dest As Any) As Long ' Always ignore the returned value, it's useless.
Private Declare Function GetMem4 Lib "msvbvm60" (ByRef Source As Any, ByRef Dest As Any) As Long ' Always ignore the returned value, it's useless.
'

Public Function IsPtrDimmed(pArray As Long, Optional FailOnZeroNegOne As Boolean = True) As Boolean
    ' Works with all array types (static or dynamic), including UDTs, but with these exceptions:
    '      Excludes BSTR String arrays.  Use IsStrDimmed instead.
    '      Excludes Varants CONTAINING arrays.
    '    Varant arrays (not an array containing a varant) will work fine.
    '    Also fixed-length String arrays (static or dynamic) work just fine.
    '    Object arrays (early or late bound) will work just fine.
    '
    ' Example:  If IsPtrDimmed(ArrPtr(SomeArray())) Then ...
    '
    Dim pSA As Long
    Dim cDims      As Integer
    Dim cElements  As Long
    '
    If pArray = 0& Then Exit Function                              ' Can happen on String arrays.
    GetMem4 ByVal pArray, pSA                                      ' De-reference.
    If pSA = 0& Then Exit Function                                  ' Dynamic undimensioned array.
    '
    GetMem2 ByVal pSA, cDims
    If cDims = 0 Then Exit Function                                ' This would be unusual, but just in case.
    '
    GetMem4 ByVal PtrAdd(pSA, 16&), cElements
    If cElements = 0& And FailOnZeroNegOne Then Exit Function      ' Decide what to do about 0 to -1 arrays.
    '
    ' If we fell through to here, we should be looking at an array with elements.
    ' Or, we specified FailOnZeroNegOne=False, and it's one of those.
    IsPtrDimmed = True
End Function

Public Function PtrAdd(ByVal Ptr As Long, ByVal iOffset As Long) As Long
    ' For adding (or subtracting) a small number from a pointer.
    ' Use PtrAddEx for adding (or subtracting) large numbers from a pointer.
    PtrAdd = (Ptr Xor &H80000000) + iOffset Xor &H80000000
End Function




---

It has the advantage of not invoking error trapping. And, as such, is almost certainly quite a bit faster than an error trapping approach.

As noted, the only arrays it won't work with are String arrays and Variants containing arrays. Regarding String arrays, I still use error trapping to check those. Regarding Variants containing arrays, basically, I just almost never do that. (It works fine for an array of Variants.)

Regards,
Elroy

EDIT: Also, to use that, you'll need the following declared somewhere:

Code:

---


Public Declare Function ArrPtr Lib "msvbvm60" Alias "VarPtr" (a() As Any) As Long



---

Here's another one, making use of a widely known typelib:

Code:

---

Option Explicit

'Reference to:
'
'  Visual Basic 6 Virtual Machine Type Library 1.0 by Michel Rutten - Declarations
'  and aliases for (undocumented) functions in the VB6 runtime library.
'
'  {VBVM6Lib.tlb}
'
'Docs & download:
'
'  http://www.xbeat.net/vbspeed/i_VBVM6Lib.html
'

Private Sub Main()
    Dim L() As Long
    Dim S() As String

    MsgBox "L: " & CStr(MemLong(ArrPtr(L)) = 0) & vbNewLine _
        & "S: " & CStr(MemLong(StrArrPtr(S)) = 0), _
          vbOKOnly, _
          "Emptiness"
    ReDim L(1)
    ReDim S(1, 1)
    MsgBox "L: " & CStr(MemLong(ArrPtr(L)) = 0) & vbNewLine _
        & "S: " & CStr(MemLong(StrArrPtr(S)) = 0), _
          vbOKOnly, _
          "Emptiness"
    MsgBox "L: " & CStr(MemWord(MemLong(ArrPtr(L)))) & vbNewLine _
        & "S: " & CStr(MemWord(MemLong(StrArrPtr(S)))), _
          vbOKOnly, _
          "Number of dimensions"
End Sub

---

Also, just as an FYI, the OP's code won't fail on a 0 to -1 array, which does occasionally happen.

Yeah, it depends on what you mean by "empty."

I assumed he was after "not yet allocated" but of course you can also allocate an array and assign it no members.

I'm using this construction

Code:

---

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

Public Function ArrayIsInitialized(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...
  ArrayIsInitialized = (memVal <> 0)        '...if it does, array is intialized
 
  If ArrayIsInitialized Then ArrayIsInitialized = UBound(arr) >= LBound(arr)

End Function

---

but not working under 64bit Excel :(

Maybe anyone knows how to change for right syntax?

Here's mine modified for the VBA. It should work in either 32-bit or 64-bit MS-Office. (Tested on Excel 64-bit.)

I did take out the PtrAdd function and just directly added. I don't feel that that'll be a problem for 64-bit systems because I seriously doubt the sign-bit will go on for our lifetimes, as a 64-bit address space is huge. However, I'm not sure whether MS-Office 32-bit is Large-Address-Aware or not. If it is, that's a bit of a problem.

Code:

---


Public Function IsPtrDimmed(pArray As LongPtr, Optional FailOnZeroNegOne As Boolean = True) As Boolean
    ' Works with all array types (static or dynamic), including UDTs, but with these exceptions:
    '      Excludes BSTR String arrays.  Use IsStrDimmed instead.
    '      Excludes Varants CONTAINING arrays.
    '    Varant arrays (not an array containing a varant) will work fine.
    '    Also fixed-length String arrays (static or dynamic) work just fine.
    '    Object arrays (early or late bound) will work just fine.
    '
    ' Example:  If IsPtrDimmed(ArrPtr(SomeArray())) Then ...
    '
    Dim pSA        As LongPtr
    Dim cDims      As Integer
    Dim cElements  As Long
    '
    If pArray = 0& Then Exit Function                              ' Can happen on String arrays.
    CopyMemory pSA, ByVal pArray, Len(pSA)                          ' De-reference.
    If pSA = 0& Then Exit Function                                  ' Dynamic undimensioned array.
    '
    CopyMemory cDims, ByVal pSA, 2&                                ' This would be unusual, but just in case.
    '
    CopyMemory cElements, ByVal (pSA + 12& + Len(pSA)), Len(pSA)    ' The first Len(pSA) is used as a proxy for the length of pvData, as they're both LongPtr types.
    If cElements = 0& And FailOnZeroNegOne Then Exit Function      ' Decide what to do about 0 to -1 arrays.
    '
    ' If we fell through to here, we should be looking at an array with elements.
    ' Or, we specified FailOnZeroNegOne=False, and it's one of those.
    IsPtrDimmed = True
End Function



---

And just a snippet for testing:

Code:

---


Sub test()
    Dim a() As Byte
    ReDim a(3) ' Comment this line out to test for "not dimmed".
    Debug.Print IsPtrDimmed(ArrPtr(a))
End Sub



---

And just for info, here's the SafeArray structure setup for either 32-bit or 64-bit:

Code:

---


Type SafeArrayBound
    cElements  As Long
    lLbound    As Long
End Type

Type SafeArrayType
    cDims      As Integer
    fFeatures  As Integer
    cbElements  As Long
    cLocks      As Long
    pvData      As LongPtr
    rgsabound(0 To cDims - 1) As SafeArrayBound ' This is just for an example.  To run, it must be setup differently.
End Type


---

NOTICE: Actually, I see a bug in the above code. I'm going camping later today so I can't fix it right now, but I'll fix it later. I AM digging past that LongPtr to get cElements, so I need to consider whether it's 32-bit or 64-bit.
EDIT: It's now fixed. The problem was that I'm jumping to the first cElements to see if any are there (and thereby jumping over rgsabound (which might be either 4 or 8 bytes, depending on the bitness). The 12& + Len(pSA) code fixes it, rather than a hardcoded 16&.