VBA chrashes when trying to execute generated sub

Question

I know I shouldn't be doing this, but I have to.

I'm trying to manipulate multidimensional arrays in VBA, in this specific case, I have to add a string to a multidimensional array, with all but the last dimension having single elements like Arr(1 To 1, 1 To 1, 1 To 3)

As VBA does not allow accessing elements of an array of arbitrary rank, I write a sub at runtime as:

Public Sub AddItemToReducedArr(ByRef Arr() As String, Dimensions As Byte, _
    Item As String
)
Dim VBComp As VBIDE.VBComponent
Dim i As Integer
Dim ArrElementS As String
Dim ArrElementR As String
    Set VBComp = ThisWorkbook.VBProject.VBComponents("modCustomCode")
    With VBComp.CodeModule
        .DeleteLines 1, .CountOfLines
        .InsertLines 1, _
            "Public Sub AddItemToReducedArrCode(ByRef Arr() As String, " & _
            "Dimensions As Byte, Item As String)"
        ArrElementS = _
            "Arr(" & Replace(String((Dimensions - 1), "*"), "*", "1, ") & _
            "*(Arr, " & Dimensions & "))"
        .InsertLines 2, "Debug.Print ""Enters Sub"""
        .InsertLines 3, "If LBound(Arr, " & Dimensions & ") = UBound(Arr, " & _
            Dimensions & ") And " & Replace(ArrElementS, "*", "UBound") & _
            " = """" Then"
        .InsertLines 4, Replace(ArrElementS, "*", "UBound") & " = Item"
        .InsertLines 5, "Else"
        ArrElementR = _
            "Arr(" & Replace(String((Dimensions - 1), "*"), "*", "1 To 1, ") & _
            "LBound(Arr, " & Dimensions & ") To UBound(Arr, " & Dimensions & ") + 1)"
        .InsertLines 6, "Redim Preserve " & ArrElementR
        .InsertLines 7, Replace(ArrElementS, "*", "UBound") & " = Item"
        .InsertLines 8, "End If"
        .InsertLines 9, "End Sub"
        Debug.Print "creates sub"
        'I also tried adding Sleep, many DoEvents here and saving, none worked
        AddItemToReducedArrCode Arr, Dimensions, Item
        Debug.Print "calls proper"
    End With
Set VBComp = Nothing
ResetCode
End Sub

ResetCode Subroutine just clears the code inside the created sub and is not listed for simplicity.

At this stage, VBA does not allow stepping through the code, rarely executes as intended and mostly does not execute the created sub and sometimes chrashes.

What can I be doing wrong, apart from using VBA for this kind of task? Do you think I have to give up and wait until I have other development options (a long time that will be) or is there a point that I'm missing?

You can test this code by creating a module named modCustomCode and using the below test:

Public Sub testASDF()
Dim Arr() As String
    ReDim Arr(1 To 1, 1 To 2)
    Arr(1, 1) = "a"
    Arr(1, 2) = "b"
    AddItemToReducedArr Arr, 2, "c"
    Debug.Print UBound(Arr, 2)
    Debug.Print Arr(1, UBound(Arr, 2))
End Sub

Answer 1

An alternative approach is to use Variants. Consider:

  Dim vdaA As Variant

  ReDim vdaA(1 To 2)
  vdaA(1) = Array(1, 2, 3, 4)
  vdaA(2) = Array(5, 6, 7, 8, 9, 10)
  Debug.Print vdaA(1)(0) & " " & vdaA(1)(1) & " " & vdaA(1)(2) & " " & vdaA(1)(3)
  Debug.Print vdaA(2)(0) & " " & vdaA(2)(1) & " " & vdaA(2)(2) & " " & _
              vdaA(2)(3) & " " & vdaA(2)(4) & " " & vdaA(2)(5)

The output from this code is:

1 2 3 4 
5 6 7 8 9 10

I have declared vdaA as a Variant and then used Redim to convert it to 1D array. You will get a syntax error if you type ReDim vdaA(1)(0 to 3). However, you can convert vdaA(1) and vdaA(2) into arrays of different sizes as I have shown. Alternatively you can pass vdaA(1) to a subroutine as a Variant and ReDim it there.

I have converted vdaA to a Jagged array. If you search for "Jagged array" you can get fuller descriptions of them but I have given you an adequate introduction for the purposes of this answer.

As I understand it, you do not need different rows to have different number of columns but I am sure you can see the flexibility that is available. You can pass vdaA(1) down to a sub-routine that converts it to an array. vdaA(1)(1) can then be passed down for conversion. With recursion you can declare arrays with as many dimensions as you determine to be necessary at run time. Other recursive routines can locate particular entries and set or get values.

Many years ago, I did get this technique to work although it hurt my brain. I no longer have that code and I would not recommend it unless nothing else could meet the requirement. However, it can be made to work if necessary.

The code below uses a much simplier technique. It only handles regular arrays and handles a maximum of five dimensions. "Five" is arbitrary and the code could easily be adjusted to a larger limit if necessary.

Before showing the code, I wish to discuss Param Arrays. I have been surprised in the past how many experienced VBA programmers seen unaware of Param Arrays or the flexibility they give you. Sorry if I am insulting your knowledge.

A possible declaration is:

Sub MySub(ByRef A As Long, ByVal B As String, ParamArray Z() As Variant)

Parameters A and B are of fixed type. I could have fixed type parameters C, D, E, and so on as is required. My last parameter is a Param Array which means I can follow the values for A and B with as many parameters as I require. The following are valid calls of this routine:

Call MySub(27, "A", 1, "X")
Call MySub(54, "B", 1, "X", 2, "Y")
Call MySub(54, "B", 1, "X", 2, "Y", 3, "Z")

In these examples I have a pattern to these extra parameters. However, VarType allows me to check the type of each parameter so they do not have to follow a simple pattern.

One of my routines has a declaration of:

Sub VdaInit(ByRef Vda As Variant, ParamArray Bounds() As Variant)

Valid calls include:

Call VdaInit(vdaA, 1, 2)
Call VdaInit(vdaA, 1, 2, -1, 4)
Call VdaInit(VdaB, 1, 2, -1, 4, 10, 15)
Call VdaInit(vdaA, 1, 2, -1, 4, 10, 15, 5, 6)
Call VdaInit(VdaB, 1, 2, -1, 4, 10, 15, 5, 6, 0, 4)

These are equivalent to:

ReDim vdaA(1 to 2)
ReDim vdaA(1 to 2, -1 to 4)
ReDim vdaA(1 to 2, -1 to 4, 10 to 15)
ReDim vdaA(1 to 2, -1 to 4, 10 to 15, 5 to 6)
ReDim vdaA(1 to 2, -1 to 4, 10 to 15, 5 to 6, 0 to 4)

Other calls are:

Call VdaStoreValue(vdaA, DateSerial(2014, 1, 7), 2, 4, 15, 5)
Result = VdaGetValue(VdaB, 2, 4, 15, 5, 4)

Which are equivalent to:

Vda(2, 4, 15, 5) = DateSerial(2014, 1, 7)
Result = VdaB(2, 4, 15, 5, 4)

You only expressed an interest in Strings but with Variants you can have any type for no extra effort.

The code behind VdaGetValue, for example, is simple:

  DimMax = NumDim(Vda)
  Select Case DimMax
    Case 1
      VdaGetValue = Vda(Indices(0))
    Case 2
      VdaGetValue = Vda(Indices(0), Indices(1))
    Case 3
      VdaGetValue = Vda(Indices(0), Indices(1), Indices(2))
    Case 4
      VdaGetValue = Vda(Indices(0), Indices(1), Indices(2), Indices(3))
    Case 5
      VdaGetValue = Vda(Indices(0), Indices(1), Indices(2), Indices(3), Indices(4))
  End Select

Not elegant but very simple and extendable up to 10 or 15 dimensions if necessary.

The code below does not include much validation of parameters and is not fully tested. However, I think it provides an adequate demonstration of this approach.

Option Explicit
Sub Test()

  Dim vdaA As Variant
  Dim VdaB As Variant

'  ReDim vdaA(1 To 2)
'  vdaA(1) = Array(1, 2, 3, 4)
'  vdaA(2) = Array(5, 6, 7, 8, 9, 10)
'  Debug.Print vdaA(1)(0) & " " & vdaA(1)(1) & " " & vdaA(1)(2) & " " & vdaA(1)(3)
'  Debug.Print vdaA(2)(0) & " " & vdaA(2)(1) & " " & vdaA(2)(2) & " " & _
'              vdaA(2)(3) & " " & vdaA(2)(4) & " " & vdaA(2)(5)

  Call VdaInit(vdaA, 1, 2)
  Debug.Print "VdaA" & VdaBoundList(vdaA)
  Call VdaInit(vdaA, 1, 2, -1, 4)
  Debug.Print "VdaA" & VdaBoundList(vdaA)
  Call VdaInit(VdaB, 1, 2, -1, 4, 10, 15)
  Debug.Print "VdaB" & VdaBoundList(VdaB)
  Call VdaInit(vdaA, 1, 2, -1, 4, 10, 15, 5, 6)
  Debug.Print "VdaA" & VdaBoundList(vdaA)
  Call VdaInit(VdaB, 1, 2, -1, 4, 10, 15, 5, 6, 0, 4)
  Debug.Print "VdaB" & VdaBoundList(VdaB)

  Call VdaStoreValue(vdaA, "A", 1, -1, 10, 5)
  Call VdaStoreValue(vdaA, 27, 1, -1, 10, 6)
  Call VdaStoreValue(vdaA, 5.3, 1, -1, 11, 5)
  Call VdaStoreValue(vdaA, DateSerial(2014, 1, 7), 2, 4, 15, 5)

  Call VdaStoreValue(VdaB, True, 1, -1, 10, 5, 0)
  Call VdaStoreValue(VdaB, "B", 1, -1, 10, 5, 1)
  Call VdaStoreValue(VdaB, False, 1, -1, 10, 5, 2)
  Call VdaStoreValue(VdaB, 1234, 2, 4, 15, 5, 4)

  Debug.Print "VdaA(1, -1, 10, 5) = " & VdaGetValue(vdaA, 1, -1, 10, 5)
  Debug.Print "VdaA(1, -1, 10, 6) = " & VdaGetValue(vdaA, 1, -1, 10, 6)
  Debug.Print "VdaA(1, -1, 11, 5) = " & VdaGetValue(vdaA, 1, -1, 11, 5)
  Debug.Print "VdaA(2, 4, 15, 5) = " & VdaGetValue(vdaA, 2, 4, 15, 5)

  Debug.Print "VdaB(1, -1, 10, 5,0) = " & VdaGetValue(VdaB, 1, -1, 10, 5, 0)
  Debug.Print "VdaB(1, -1, 10, 5,1) = " & VdaGetValue(VdaB, 1, -1, 10, 5, 1)
  Debug.Print "VdaB(1, -1, 10, 5,2) = " & VdaGetValue(VdaB, 1, -1, 10, 5, 2)
  Debug.Print "VdaB(2, 4, 15, 5, 4) = " & VdaGetValue(VdaB, 2, 4, 15, 5, 4)

End Sub
Sub VdaInit(ByRef Vda As Variant, ParamArray Bounds() As Variant)

  ' Vda:     A variant which is to be converted to a multi-dimensional array.
  ' Bounds:  One or more pairs of bounds for the dimensions.  The number of pairs
  '          defines the number of dimensions.  For each pair, the first value is
  '          the lower bound and the second is the upper bound.

  ' This routine creates dimension 1 and calls VdaInitSub to create
  ' further dimensions

  ' I use Debug.Assert because I am testing for errors that only the programmer
  ' should see.
  Debug.Assert UBound(Bounds) >= 1       ' Need at least one pair of bounds
  Debug.Assert UBound(Bounds) Mod 2 = 1  ' Need even number of bounds
  ' I do not check that the bounds are valid integers

  Select Case UBound(Bounds)
    Case 1
      ReDim Vda(Bounds(0) To Bounds(1))
    Case 3
      ReDim Vda(Bounds(0) To Bounds(1), Bounds(2) To Bounds(3))
    Case 5
      ReDim Vda(Bounds(0) To Bounds(1), Bounds(2) To Bounds(3), _
                Bounds(4) To Bounds(5))
    Case 7
      ReDim Vda(Bounds(0) To Bounds(1), Bounds(2) To Bounds(3), _
                Bounds(4) To Bounds(5), Bounds(6) To Bounds(7))
    Case 9
      ReDim Vda(Bounds(0) To Bounds(1), Bounds(2) To Bounds(3), _
                Bounds(4) To Bounds(5), Bounds(6) To Bounds(7), _
                Bounds(8) To Bounds(9))
  End Select

End Sub
Function VdaBoundList(ByVal Vda As Variant) As String

  ' Vda: A variant which has been converted to a multi-dimensional array.

  ' Returns a string of the format: "(L1 to U1, L2 to U3 ... )
  ' which gives the dounds of each dimension

  Dim DimCrnt As Long
  Dim DimMax As Long

  DimMax = NumDim(Vda)

  VdaBoundList = "("
  For DimCrnt = 1 To DimMax
    VdaBoundList = VdaBoundList & LBound(Vda, DimCrnt) & " to " & UBound(Vda, DimCrnt)
    If DimCrnt < DimMax Then
      VdaBoundList = VdaBoundList & ", "
    End If
  Next
  VdaBoundList = VdaBoundList & ")"

End Function
Function VdaGetValue(ByRef Vda As Variant, ParamArray Indices() As Variant) As Variant

  ' Vda:     A variant which has been converted to a multi-dimensional array.
  ' Indices  The parameters are the indices of the entry within Vda from which the value is got.
  '          The number of indices must match the number of dimensions of Vda.

  ' Example: Result = VdaGetValue(XYZ, 1, 2, 3)
  '          is equivalent to Result = XYZ(1, 2, 3)
  '          providing XYZ has three dimensions and 1, 2 and 3 are within the
  '          bounds of their dimension

  Dim DimCrnt As Long
  Dim DimMax As Long

  DimMax = NumDim(Vda)

  Debug.Assert UBound(Indices) = DimMax - 1    ' Wrong number of parameters
  'For DimCrnt = 1 To DimMax
  '  Debug.Assert IsNumeric(indices(DimCrnt - 1)) ' Index must be numeric
  '  ' Index not within bounds
  '  Debug.Assert LBound(indices, DimCrnt - 1) <= indices(DimCrnt - 1) And _
  '               UBound(indices, DimCrnt - 1) >= indices(DimCrnt - 1)
  'Next

  Select Case DimMax
    Case 1
      VdaGetValue = Vda(Indices(0))
    Case 2
      VdaGetValue = Vda(Indices(0), Indices(1))
    Case 3
      VdaGetValue = Vda(Indices(0), Indices(1), Indices(2))
    Case 4
      VdaGetValue = Vda(Indices(0), Indices(1), Indices(2), Indices(3))
    Case 5
      VdaGetValue = Vda(Indices(0), Indices(1), Indices(2), Indices(3), Indices(4))
  End Select

End Function
Sub VdaStoreValue(ByRef Vda As Variant, ParamArray ValAndIndices() As Variant)

  ' Vda:           A variant which has been converted to a multi-dimensional array.
  ' ValAndIndices  The first parameter is the value to be stored.  Since this is a
  '                Variant array it can be of any type.  The second and subsequent
  '                parameters are the indices of the entry within Vda into which
  '                the value is to be stored.  The number of indices must match the
  '                number of dimensions of Vda.

  ' Example: VdaStoreValue(XYZ, "Example", 1, 2, 3)
  '          is equivalent to XYZ(1, 2, 3) = "Example"
  '          providing XYZ has three dimensions and 1, 2 and 3 are within the
  '          bounds of their dimension

  Dim DimCrnt As Long
  Dim DimMax As Long

  DimMax = NumDim(Vda)

  Debug.Assert UBound(ValAndIndices) = DimMax    ' Wrong number of parameters
  ' I do not check the indices are numeric and within the appropriate bounds

  Select Case DimMax
    Case 1
      Vda(ValAndIndices(1)) = ValAndIndices(0)
    Case 2
      Vda(ValAndIndices(1), ValAndIndices(2)) = ValAndIndices(0)
    Case 3
      Vda(ValAndIndices(1), ValAndIndices(2), ValAndIndices(3)) = ValAndIndices(0)
    Case 4
      Vda(ValAndIndices(1), ValAndIndices(2), ValAndIndices(3), _
          ValAndIndices(4)) = ValAndIndices(0)
    Case 5
      Vda(ValAndIndices(1), ValAndIndices(2), ValAndIndices(3), _
          ValAndIndices(4), ValAndIndices(5)) = ValAndIndices(0)
  End Select

End Sub

Public Function NumDim(ParamArray TestArray() As Variant) As Integer

  ' Returns the number of dimensions of TestArray.

  ' If there is an official way of determining the number of dimensions, I cannot find it.

  ' This routine tests for dimension 1, 2, 3 and so on until it get a failure.
  ' By trapping that failure it can determine the last test that did not fail.

  ' Coded June 2010. Documentation added July 2010.

  ' *  TestArray() is a ParamArray because it allows the passing of arrays of any type.
  ' *  The array to be tested is not TestArray but TestArray(LBound(TestArray)).
  ' *  The routine does not validate that TestArray(LBound(TestArray)) is an array.  If
  '    it is not an array, the routine return 0.
  ' *  The routine does not check for more than one parameter.  If the call was
  '    NumDim(MyArray1, MyArray2), it would ignore MyArray2.

  Dim TestDim                   As Integer
  Dim TestResult                As Integer

  On Error GoTo Finish

  TestDim = 1
  Do While True
    TestResult = LBound(TestArray(LBound(TestArray)), TestDim)
    TestDim = TestDim + 1
  Loop

Finish:

  NumDim = TestDim - 1

End Function

Edit New section explaining a "problem" with Param Arrays and giving a possible solution.

Suppose I have three routines Main, SubA and SubB with both SubA and SubB having Param Arrays named "Param" as their only parameters. Suppose further that SubA passes the Param Array it receives from Main to SubB.

Within Main I have a call of SubA:

Call SubA("A", 1, #1/10/2014#, 2.45)

For SubA, Param will have four entries:

Param(0) = "A"
Param(1) = 1
Param(2) = #1/10/2014#, 2.45
Param(3) = 2.45

If SubA then calls SubB:

Call SubB(Param)

then SubB's Param will have not four entries. Instead it will have a single entry:

Param(0) = Array("A", 1, #1/10/2014#, 2.45)

I call this nesting. If SubB can only be called by SubA then SubB can be coded to handle a nested Param Array. However, if SubB can also be called by Main, it gets a little messy. It gets messer still if you have SubC and SubD with Param Arrays and they can be called from any of their parents.

I use the following routine to convert Param Arrays and Param Arrays nested to any depth to a consistent format:

Sub DeNestParamArray(RetnValue() As Variant, ParamArray Nested() As Variant)

  ' Coded Nov 2010

  ' Each time a ParamArray is passed to a sub-routine, it is nested in a one
  ' element Variant array.  This routine finds the bottom level of the nesting and
  ' sets RetnValue to the values in the original parameter array so that other routine
  ' need not be concerned with this complication.

  Dim NestedCrnt                As Variant
  Dim Inx                       As Integer

  NestedCrnt = Nested
  ' Find bottom level of nesting
  Do While True
    If VarType(NestedCrnt) < vbArray Then
      ' Have found a non-array element so must have reached the bottom level
      Debug.Assert False   ' Should have exited loop at previous level
      Exit Do
    End If
    If NumDim(NestedCrnt) = 1 Then
      If LBound(NestedCrnt) = UBound(NestedCrnt) Then
        ' This is a one element array
        If VarType(NestedCrnt(LBound(NestedCrnt))) < vbArray Then
          ' But it does not contain an array so the user only specified
          ' one value; a literal or a non-array variable
          ' This is a valid exit from this loop
            Exit Do
        End If
        NestedCrnt = NestedCrnt(LBound(NestedCrnt))
      Else
        ' This is a one-dimensional, non-nested array
        ' This is the usual exit from this loop
        Exit Do
      End If
    Else
      Debug.Assert False   ' This is an array but not a one-dimensional array
      Exit Do
    End If
  Loop

  ' Have found bottom level array.  Save contents in Return array.
  ReDim RetnValue(LBound(NestedCrnt) To UBound(NestedCrnt))
  For Inx = LBound(NestedCrnt) To UBound(NestedCrnt)
    If VarType(NestedCrnt(Inx)) = vbObject Then
      Set RetnValue(Inx) = NestedCrnt(Inx)
    Else
      RetnValue(Inx) = NestedCrnt(Inx)
    End If
  Next

End Sub

Answer 2

Thank you, Mr. Corbett, for giving me the idea:

So even though you modify the code at runtime, it's still the old (compiled) code that will get executed.

I changed the sub to a function and added a return line;

.InsertLines 1, "Public Function AddItemToReducedArrCode(ByRef Arr() As String, " & _
    Dimensions As Byte, Item As String) As String()"
...
.InsertLines 8, "AddItemToReducedArrCode = Arr"

Finally, I called the created function as such:

Arr = Application.Run("AddItemToReducedArrCode", Arr, Dimensions, Item)

I guess that it was a very simple oversight to not to try this approach before posting, but hopefully someone will benefit. Now I can work arrays to tears in VBA!