Clash Royale CLAN TAG#URR8PPP

check if array has values and bypass if empty

So my code is setting up to send an email with all the lines that meet a certain cell name (Missing Text). if there are none of those in the search i want it to bypass and enter in a "None". If there are cells that have it, it works great, but if there is none i get a Subscript out o range error.

Dim MissingText() As Variant
Dim WrongNum() As Variant
Dim BlankText() As Variant
Dim objOutlook As Object
Dim objMsg As Object


Set objOutlook = CreateObject("Outlook.Application")
Erase MissingText, WrongNum, BlankText

Listed = 0
Ending = Cells(Rows.Count, 5).End(xlUp).Row
n = 0
For Listed = 2 To Ending
If Cells(Listed, 10).Value = "Missing Text" Then
ReDim Preserve MissingText(n)
MissingText(n) = Listed
n = n + 1
End If

Next Listed
If IsEmpty(MissingText) Then
MissingTogether = "None"
GoTo MissingSkip
End If
CountArray = UBound(MissingText, 1) - LBound(MissingText, 1) + 1
CountArray = CountArray - 1
MissingTogether = Join(MissingText, ", ")
MissingSkip:


(continues on )
At the CountArray = UBound(MissingText, 1) - LBound(MissingText, 1) + 1 is when the error occurs. any help would be nice, thank you.

n>0

n > 0

n

2 Answers
2

I will use a string variable and split() it.

split()

dim strMissing as string, aryMissing as variant

For Listed = 2 To Ending
If Cells(Listed, 10).Value = "Missing Text" Then
strMissing = Listed & ", " & strMissing
End If
Next Listed

If strMissing = "" then
MissingTogether = "None"
GoTo MissingSkip
else
aryMissing = split(strMissing, ", ")
CountArray = UBound(MissingText, 1) - LBound(MissingText, 1) + 1
End If


As pointed out in the comments, there isn't a native way to determine if an array is uninitialized in VBA. However, you can examine its memory footprint to see if its variable contains a null pointer. Note that VarPtr throws a type mismatch for arrays, so it needs to be wrapped in a Variant first:

VarPtr

Variant

'In declarations section:
#If VBA7 Then
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias _
"RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, _
ByVal length As Long)
#Else
Private Declare Sub CopyMemory Lib "kernel32" Alias _
"RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, _
ByVal length As Long)
#End If

Private Const VT_BY_REF As Integer = &H4000&
Private Const DATA_OFFSET As Long = 8

Private Function IsUninitializedArray(SafeArray As Variant) As Boolean
If Not IsArray(SafeArray) Then
Exit Function
End If

Dim vtype As Integer
'First 2 bytes are the VARENUM.
CopyMemory vtype, SafeArray, LenB(vtype)
#If VBA7 Then
Dim lp As LongPtr
#Else
Dim lp As Long
#End If
'Get the data pointer.
CopyMemory lp, ByVal VarPtr(SafeArray) + DATA_OFFSET, LenB(lp)
'Make sure the VARENUM is a pointer.
If (vtype And VT_BY_REF) <> 0 Then
'Dereference it for the actual data address.
CopyMemory lp, ByVal lp, LenB(lp)
IsUninitializedArray = lp <> 0
End If
End Function


Usage example:

Public Sub Example()
Dim Test() As String
MsgBox IsUninitializedArray(Test) 'False

Test = Split(vbNullString)
MsgBox IsUninitializedArray(Test) 'True

Erase Test
MsgBox IsUninitializedArray(Test) 'False
End Sub


By clicking "Post Your Answer", you acknowledge that you have read our updated terms of service, privacy policy and cookie policy, and that your continued use of the website is subject to these policies.