0

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.

  • 1
    Why not test for `n>0` ? –  Sep 14 '18 at 22:05
  • LOL i think i was trying to make it more complicated, plus i have been staring at it or awhile. Thank you – AmongTheShadows Sep 14 '18 at 22:18
  • Yep, you can check if `n > 0` or use a boolean variable (in cases where you don't have `n`), or use the function mentioned in [this answer](https://stackoverflow.com/a/5483443/4934172) if you have to check for initialized array in many places in your code. – 41686d6564 stands w. Palestine Sep 14 '18 at 22:20
  • Yeah, redim'ming a variant after erase is fine but testing it for anything useful is a waste of time. IsArray is true, IsMissing and IsEmpty are both false. LBound and UBound both throw errors. –  Sep 14 '18 at 22:22

2 Answers2

1

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:

'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
Comintern
  • 21,855
  • 5
  • 33
  • 80
0

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

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
PaichengWu
  • 2,649
  • 1
  • 14
  • 28