Need assistance with detecting an empty variant array.

[OaklandJim]

Team Mr. Excel

In a sub I have a variant array. The sub is called by the Change event when the user selects an insurance provider from a validation dropdown list. That sub calls a function that fills the variant array with medical insurance plan names (plans) offered by the selected provider. A Sub then removes any entries that have already been selected by the user. When all that is done, the array may be empty.

Try as I might I cannot figure out how to determine if an array is empty. Furthermore, when I try various possibilities code stops on the offending line, which is highlighted, despite telling Excel On Error Goto ErrHandler and On Error Resume Next.

There is much code in my workbook but relevant code is below. I apologize in advance for my bloat code. Its difficult for me to remember what I've done so I put a lot of comments in. Techniques are dinasaurish and/or amateurish too. But hey, you do what you can and know. And I know that the code logic is at least mostly right.

Any assistance would be greatly appreciated!

The first sub -- FillPlanTypesMedical -- runs by the worksheet change event when user selects a provider from a dropdown. Next is Function PlansListMed called by the sub. It puts the name(s) of medical insurance plans offered by the provider selected by the user into a variant array. Next is the sub DeleteSelectedPlans which, needless to say, deletes the plan(s) for a provider that have already been selected by the user. Finally is Function DeleteElementFromArray which does the actual deletion.

The error occurs during step 4 below.

Sub FillPlanTypesMedical(ByVal prProviderCell As Range)

'   ----------------------
'       Error Handling
'   ----------------------
    Dim sSubName As String
    Dim sStepID As String
    
    sSubName = "FillPlanTypesMedical"
    sStepID = "1. Initializations."
    On Error GoTo ErrHandler
'   ----------------------
    
    Dim vEnableStatus As Variant
    
    With Application
        vEnableStatus = .EnableEvents
        .EnableEvents = False
    End With

'   ------------------------------------------
    sStepID = "2. Handle no provider selected"
'   ------------------------------------------
    
    If prProviderCell.Cells(1).Value = "" _
     Then
        prProviderCell.Offset(0, 1).Value = ""
        prProviderCell.Offset(0, 1).Validation.Delete
        Application.EnableEvents = True
        Exit Sub
    End If
    
'   Array containg the list
    Dim avPlansList() As Variant

'   Holds csv list of plan types for the respective provider to specify
'   the list of plans for data validation.
    Dim sList As String
    
'   Used to access array elements.
    Dim iIndex As Long
    
'   Used to check for plans list array is empty.
    Dim bArrayIsEmpty As Boolean
    
    Dim sProvider As String
        
    sList = ""

    sProvider = prProviderCell.Value

'   ----------------------------------------------------
    sStepID = "3. Get plans for the selected provider."
'   ----------------------------------------------------
    

'   Use function PlansList to gather the plans list (for a provider)
'   and put the array returned into the local array variable.
    
    avPlansList = PlansListMed(prProviderCell.Value)

'   ----------------------------------------------------
    sStepID = "4. Delete plans that are already selected"
'   ----------------------------------------------------
'
    Call DeleteSelectedPlans(prProviderCell, avPlansList)

    sStepID = "4b. Check plans list array is empty"
    bArrayIsEmpty = True
    On Error Resume Next
    bArrayIsEmpty = Not IsNumeric(UBound(avPlansList))
    On Error GoTo ErrHandler

    sStepID = "4c. Clear plans selection(s) cell"
    If bArrayIsEmpty _
     Then
        MsgBox "All plans for " & sProvider & " have been selected.", vbCritical, "Selecting a provider."
        With prProviderCell
            .Value = ""
            .Offset(0, 1).Value = ""
            .Offset(0, 1).Validation.Delete
        End With
        Application.EnableEvents = True
        Exit Sub
    End If

'   --------------------------------------------
    sStepID = "5. Create csv list of plan types"
'   --------------------------------------------

'   Loop all array elements.
    For iIndex = 1 To UBound(avPlansList)

'       Add the current plan type to the string containing the csv list
'       for data validation.
        sList = sList & avPlansList(iIndex)

'       Add comma if not the final plan type in the list.
        If iIndex < UBound(avPlansList) _
         Then
            sList = sList & ","
        End If

    Next

'   ----------------------------------------------------
    sStepID = "6. Unprotecting medical inputs worksheet"
'   ----------------------------------------------------

'   Must unprotect to change data validation list.
    
    prProviderCell.Parent.Unprotect
    
'   ----------------------------------------------------
    sStepID = "7. Put list of plan types into dropdown"
'   ----------------------------------------------------

'   Put list into the data validation dropdown for the respective plan types cell.
    
    With prProviderCell.Offset(0, 1).Validation
        .Delete
        .Add Type:=xlValidateList, _
             AlertStyle:=xlValidAlertStop, _
             Operator:=xlBetween, _
             Formula1:=Trim(sList)
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = "Selecting a plan."
        .InputMessage = ""
        .ErrorMessage = "Select one of the plans listed in the dropdown."
        .ShowInput = True
        .ShowError = True
    End With
    
'   ------------------------------------------------
    sStepID = "8. Protect medical inputs worksheet"
'   ------------------------------------------------
     
    If [AutoprotectWorksheets?] Then prProviderCell.Parent.Protect UserInterfaceOnly:=True
    
    Application.EnableEvents = vEnableStatus

Exit Sub

ErrHandler:

Application.EnableEvents = True

Call ErrorMessage(Err.Number, Err.Description, sSubName, sStepID)

End Sub

Function PlansListMed(psProvider As String) As Variant
    
'   ----------------------
'       Error Handling
'   ----------------------
    Dim sSubName As String
    Dim sStepID As String
    
    sSubName = "PlansListMed"
    sStepID = "Declarations"
    On Error GoTo ErrHandler
'   ----------------------
    
    Dim vEnableStatus As Variant
    
    With Application
        vEnableStatus = .EnableEvents
        .EnableEvents = False
    End With

    Dim rProviders As Range

    Dim rPlans As Range

    Dim rCell As Range

    Dim iPlanIndex As Long

    Dim iArrayIndex As Long

    Dim asPlansList() As Variant

    Set rProviders = [Providers_MedPlansData]

    Set rPlans = [PlanNames_MedPlansData]
    
'   --------------------------------------
      sStepID = "2. Iterating Providers"
'   --------------------------------------
    For Each rCell In rProviders

        iPlanIndex = iPlanIndex + 1

        If rCell.Value = psProvider And rCell.Value <> "" And rCell.Value <> 0 _
         Then

'   --------------------------------------
      sStepID = "3. Add Element to Array"
'   --------------------------------------
                  
            iArrayIndex = iArrayIndex + 1

            ReDim Preserve asPlansList(iArrayIndex)

            asPlansList(iArrayIndex) = rPlans.Cells(iPlanIndex)

        End If

    Next rCell
    
    PlansListMed = asPlansList()
    
    Application.EnableEvents = vEnableStatus

Exit Function

ErrHandler:

Application.EnableEvents = vEnableStatus

Call ErrorMessage(Err.Number, Err.Description, sSubName, sStepID)

End Function

'Iterates through providers that were previously selected by the user in a medical plans
'worksheet (codename MedicalInputs) or drug plans worksheet (codename ResultDrug1 or ResultDrug2)
'to determine which plans -- for the provider that was just selected by the user (as specified in
'the single-celled range parameter prProviderCell)-- have already been selected, if any. Already
'selected plan(s) is/are removed from the array containing the list of selectable plans (list is
'in ByRef arrparameter pavPlans) for the just selected provider.

'Called by Subs Sub_FillPlanTypesDrugs and Sub_FillPlanTypesMed
'Calls Function DeleteElementFromArray

Sub DeleteSelectedPlans(prProviderCell As Range, ByRef pavPlans() As Variant)

'   ----------------------
'       Error Handling
'   ----------------------
    Dim sSubName As String
    Dim sStepID As String
    
    sSubName = "DeleteSelectedPlans"
    sStepID = "1. Declarations"
    On Error GoTo ErrHandler
'   ----------------------

    Dim vEnableStatus As Variant
    
    With Application
        vEnableStatus = .EnableEvents
        .EnableEvents = False
    End With

'   Worksheet with inhputs that is being processed.
    Dim wsInputs As Worksheet

'   Range in drug results worksheet where user-selected providers are entered.
    Dim rProviders As Range
    
    Dim rCell As Range
    
'   Current provider name while iterating through all providers.
    Dim sProvider As String
    
'   Current plan name while iterating through all providers looking for plan
'   already selected.
    Dim sProviderPlan As String
    
'   The "other" plan name found for the respective provider.
    Dim sOtherPlanFound As String
    
'   Holds csv string used to gather names of plans used for a provider.
    Dim sPlansFound As String
    
    Dim bIsMedPlansWorksheet As Boolean
    
'   Set worksheet object to poiont to the sheet being proocessed.
    Set wsInputs = prProviderCell.Parent
    
'   Set the range variable rProviders that points to the range in drug
'   results where SELECTED provider names are located.
    Set rProviders = wsInputs.Range("Providers")
    
'   Get provider name for the cell passed here. It is the one user changed.
    sProvider = prProviderCell.Value
    
    bIsMedPlansWorksheet = False
    If wsInputs.CodeName = "MedicalInputs" Then bIsMedPlansWorksheet = True

'   --------------------------------------
      sStepID = "2. Iterating providers"
'   --------------------------------------

    For Each rCell In rProviders

'       -------------------------------------------
         sStepID = "3. Get plans for a provider"
'       -------------------------------------------
'       Loop all provider cells to look for plans already selected.
        If rCell.Value = sProvider _
         Then
         
'       --------------------------------------
         sStepID = "4. Get the plan name"
'       --------------------------------------

'           Get corresponding plan name for the provider in current provider rCell being
'           processed. It is one cell below the provider. If processing medical plans then
'           plan name is one cell to the right of the provider cell and if processing drug
'           plans then the plan name is one cell below the provider cell.
            If bIsMedPlansWorksheet _
             Then
                sProviderPlan = rCell.Offset(0, 1).Value
            Else
                sProviderPlan = rCell.Offset(1, 0).Value
            End If

'           Add name of all plans found to the "csv" string used to determine if the plan
'           has already been selected.
            
'       --------------------------------------------
         sStepID = "5. Set a plans found variable"
'       --------------------------------------------
            
            sPlansFound = sPlansFound & sProviderPlan & ","

'       --------------------------------------------
         sStepID = "6. Handle duplicate plan found"
'       --------------------------------------------

'           Check whether the current plan being processed is already in use.
'           Use InStr function to determine if the name of plan being processed
'           is within the string used to record plan types as csv.
            If InStr(1, sPlansFound, sProviderPlan, vbTextCompare) <> 0 And sProviderPlan <> "" _
             Then

'               If so then use function DeleteElementFromArray to delete that
'               already-used plan from the array containing all plans.
                pavPlans = DeleteElementFromArray(sProviderPlan, pavPlans)

            End If

        End If
    
    Next rCell

    Application.EnableEvents = vEnableStatus

Exit Sub

ErrHandler:

Application.EnableEvents = True

Call ErrorMessage(Err.Number, Err.Description, sSubName, sStepID)

End Sub

Function DeleteElementFromArray( _
  sValueToDelete As String, _
  pavList() As Variant) As Variant

'   ----------------------
'       Error Handling
'   ----------------------
    Dim sSubName As String
    Dim sStepID As String
    
    sSubName = "DeleteElementFromArray"
    sStepID = "1. Declarations"
    On Error GoTo ErrHandler
'   ----------------------

    Dim vEnableStatus As Variant
    
    With Application
        vEnableStatus = .EnableEvents
        .EnableEvents = False
    End With

'   Index used to keep track of which element in parameter array is being accessed.
    Dim iLoopIndex As Long
    
'   Index for accessing elements in the results array.
    Dim iResultIndex As Long
    
'   Local/temp results array.
    Dim avResult() As Variant
    
'   Iterate through all elements in the parameter array.
    For iLoopIndex = 1 To UBound(pavList)
        
'       If the parameter array element is not the same as the value to remove...
        If pavList(iLoopIndex) <> sValueToDelete _
         Then
         
'           Increment the results array index and redim the results array with iResultIndex
            iResultIndex = iResultIndex + 1
            ReDim Preserve avResult(iResultIndex)
          
'           Put the value from the parameter array into the local result array.
            avResult(iResultIndex) = pavList(iLoopIndex)
        End If
      
    Next

    Application.EnableEvents = vEnableStatus
    
'   Return the results array to the caller.
    DeleteElementFromArray = avResult

Exit Function

ErrHandler:

Application.EnableEvents = vEnableStatus

Call ErrorMessage(Err.Number, Err.Description, sSubName, sStepID)

End Function

 

[Peter_SSs]

the offending line, which is highlighted,

There is a lot of code and nothing to me is obviously highlighted. If you want to highlight anything in code, use the 'RICH' code tags and then you can format code text as you like.
Example

Sub Close_Active_Workbook()
  ActiveWorkbook.Close
End Sub

See if you are able to apply something like this

Sub TestVariants()
  Dim V1 As Variant, V2 As Variant, V3 As Variant
  
  V1 = Split("cat dog")
  V2 = "rat"
  Debug.Print TypeName(V1)
  Debug.Print TypeName(V2)
  Debug.Print TypeName(V3)
End Sub

 

[Alex Blakenburg]

The error occurs during step 4 below.

Not having a workbook to run the code on it's a bit hard to replicate any issue you are having.
Can you be a bit more specific on how the issue you are having shows up and which array is causing the issue.
The terminology out there is a bit inconsistent but you mainly seem to be using Dynamic Arrays of Variants Dim avPlansList() As Variant
as opposed to a Variant Array which would be Dim avPlansList As Variant (they behave differently when empty).

As far as I can tell your boolean test bArrayIsEmpty is working, so how is the issue showing up.

 

[OaklandJim]

I cannot tell you how much I appreciate any assistance. I have a lot of time in this workbook.

I'm not familiar with the behavior difference when empty between dynamic array of variants and variant array so perhaps that is the issue. I seem to be using dynamic array.

The error occurs here, after call to the sub that removes elements from the array (Sub DeleteSelectedPlans). The array may be empty after that sub call. But when I try to check for that I get subscript out of range error.

sStepID = "4b. Check plans list array is empty"
bArrayIsEmpty = True
On Error Resume Next

bArrayIsEmpty = Not IsNumeric(UBound(avPlansList))

'<= error occurs here
On Error GoTo ErrHandler

Like I said before, I get an error despite trying to get arounbd it.

Needless to say, I'll gladly answer any questions.

Have a great day.

Jim

 

[Alex Blakenburg]

I didn't have your line On Error GoTo ErrHandler
when I tested it.

Firstly try this:
Replace

    bArrayIsEmpty = True
    On Error Resume Next
    bArrayIsEmpty = Not IsNumeric(UBound(avPlansList))

With this:

bArrayIsEmpty = (Not Not avPlansList) = 0

Note: This only because you have a Dynamic Array (it won't work on a Variant Array by my definition in post 3)

The Other option would be to Clear the error before adding in the GoTo ErrHandler

    Err.Clear
    On Error GoTo ErrHandler

 

[OaklandJim]

Excellent. Incredibly helpful! Code...

bArrayIsEmpty = (Not Not avPlansList) = 0

...seems to work well. (I need to do more testing so hopefully it'll keep working.)

So I understand, what is your command line doing?

 

[Alex Blakenburg]

So I understand, what is your command line doing?

The explanations were far too technical for me and use wording such as:
"Not Not Arrayname returns the actual pointer or 0 if the array is uninitialised" and "SafeArray structure"
I originally saw it on Stack Overflow, see post by RandomCoder and the comment on the post by Ross - Link
Using that wording as a basis for another search there is a more indepth and more technical discussion here on VB Forums - Link