Search code examples
vbamultidimensional-arraydynamicdimensions

Dynamicaly change the nr. of dimensions of a VBA array


I was wondering if there was any way to change the number of dimensions of an array:

  1. In VBA,
  2. Depending on an integer max_dim_bound which indicates the the desired nr. of dimensions.
  3. Allowing for a starting index of the dimension: E.G. `array(4 to 5, 3 to 6) where the number of 3 to 6 are variable integers.

  4. *In the code itself without extra tools

  5. *Without exporting the code.

To be clear, the following change does not change the nr of dimensions of an array, (merely the starting end ending indices of the elements in each respective dimension):

my_arr(3 to 5, 6 to 10) 
'changed to:
my_arr(4 to 8, 2 to 7)

The following example would be a successfull change of the nr. of dimensions in an array:

my_arr(3 to 5, 6 to 10) 
'changed to:
my_arr(4 to 8, 2 to 7,42 to 29)

This would also be a change in the nr. of dimensions in an array:

my_arr(4 to 8, 2 to 7,42 to 29)
'changed to:
my_arr(3 to 5, 6 to 10) 

So far my attempts have consisted of:

Sub test_if_dynamically_can_set_dimensions()
    Dim changing_dimension() As Double
    Dim dimension_string_attempt_0 As String
    Dim dimension_string_attempt_1 As String
    Dim max_dim_bound As String
    Dim lower_element_boundary As Integer
    Dim upper_element_boundary As Integer

    upper_element_boundary = 2
    max_dim_bound = 4

    For dimen = 1 To max_dim_bound
        If dimen < max_dim_bound Then
            dimension_string_attempt_0 = dimension_string_attempt_0 & "1 To " & upper_element_boundary & ","
            MsgBox (dimension_string_attempt_0)
        Else
            dimension_string_attempt_0 = dimension_string_attempt_0 & "1 To " & upper_element_boundary
        End If
    Next dimen
    MsgBox (dimension_string_attempt_0)
    'ReDim changing_dimension(dimension_string_attempt_0) 'does not work because the "To" as expected in the array dimension is not a string but reserved word that assists in the operation of setting an array's dimension(s)
    'ReDim changing_dimension(1 & "To" & 3, 1 To 3, 1 To 3) 'does not work because the word "To" that is expected here in the array dimension is not a string but a reserved word that assists the operation of setting an array's dimension(s).
    'ReDim changing_dimension(1 To 3, 1 To 3, 1 To 3, 1 To 3)

    'attempt 1:
    For dimen = 1 To max_dim_bound
        If dimen < max_dim_bound Then
            dimension_string_attempt_1 = dimension_string_attempt_1 & upper_element_boundary & ","
            MsgBox (dimension_string_attempt_1)
        Else
            dimension_string_attempt_1 = dimension_string_attempt_1 & upper_element_boundary
        End If
    Next dimen
    MsgBox (dimension_string_attempt_1)
    ReDim changing_dimension(dimension_string_attempt_1) 'this does not change the nr of dimensions to 2, but just one dimension of "3" and "3" = "33" = 33 elements + the 0th element
    'changing_dimension(2, 1, 2, 1) = 4.5
    'MsgBox (changing_dimension(2, 1, 2, 1))
End Sub

*Otherwise a solution is to:

  1. Export the whole code of a module, and at the line of the dimension substitute the static redimension of the array, with the quasi-dynamic string dimension_string.
  2. Delete the current module
  3. Import the new module with the quasi-dynamic string dimension_string as a refreshed static redimension in the code.

However, it seems convoluted and I am curious if someone knows a simpler solution.

Note that this is not a duplicate of: Dynamically Dimensioning A VBA Array? Even though the question seems to mean what I am asking here, the intention of the question seems to be to change the nr. of elements in a dimension, not the nr. of dimensions. (The difference is discussed in this article by Microsoft.)


In an attempt to apply the answer of Uri Goren, I analyzed every line and looked up what they did, and commented my understanding behind it, so that my understanding can be improved or corrected. Because I had difficulty not only running the code, but also understanding how this answers the question. This attempt consisted of the following steps:

  1. Right click the code folder ->Insert ->Class Module Then clicked: Tools>Options> "marked:Require variable declaration" as shown here at 00:59.
  2. Next I renamed the class module to Renamed class module to FlexibleArray

  3. Next I wrote the following code in class module FlexibleArray:

    Option Explicit
    Dim A As New FlexibleArray
    Private keys() As Integer
    Private vals() As String
    Private i As Integer
    
    Public Sub Init(ByVal n As Integer)
       ReDim keys(n) 'changes the starting element index of array keys to 0 and index of last element to n
       ReDim vals(n) 'changes the starting element index of array keys to 0 and index of last element to n
       For i = 1 To n
            keys(i) = i 'fills the array keys as with integers from 1 to n
       Next i
    End Sub
    
    Public Function GetByKey(ByVal key As Integer) As String
       GetByKey = vals(Application.Match(key, keys, False))
       ' Application.Match("what you want to find as variant", "where you can find it as variant", defines the combination of match type required and accompanying output)
        'Source: https://msdn.microsoft.com/en-us/vba/excel-vba/articles/worksheetfunction-match-method-excel
        ' If match_type is 1, MATCH finds the largest value that is less than or equal to lookup_value. Lookup_array must be placed in ascending order: ...-2, -1, 0, 1, 2, ..., A-Z, FALSE, TRUE.
        ' If match_type is 0, MATCH finds the first value that is exactly equal to lookup_value. Lookup_array can be in any order.
        ' If match_type is -1, MATCH finds the smallest value that is greater than or equal to lookup_value. Lookup_array must be placed in descending order: TRUE, FALSE, Z-A, ...2, 1, 0, -1, -2, ..., and so on.
    
        'so with False as 3rd optional argument "-1" it finds the smallest value greater than or equal to the lookup variant, meaning:
        'the lowest value of keys that equals or is greater than key is entered into vals,
        'with keys as an array of 1 to n, it will return key, if n >= key. (if keys is initialized right before getbykey is called and is not changed inbetween.
    
       'vals becomes the number inside a string. So vals becomes the number key if key >= n.
    
    End Function
    
    Public Sub SetByKey(ByVal key As Integer, ByVal val As String)
       vals(Application.Match(key, keys, False)) = val
       'here string array vals(element index: key) becomes string val if key >=n (meaning if the element exists)
    
    
    End Sub
    
    Public Sub RenameKey(ByVal oldName As Integer, ByVal newName As Integer)
       keys(Application.Match(oldName, keys, False)) = newName
        'here keys element oldname becomes new name if it exists in keys.
    End Sub
    
  4. And then I created a new module11 and copied the code below in it, including modifications to try and get the code working.

    Option Explicit
    Sub use_class_module()
    Dim A As New FlexibleArray 'this dimensions object A but it is not set yet
    A.Init (3) 'calls the public sub "Init" in class module FlexibleArray, and passes integer n = 3.
    'A.SetByKey(1, "a") 'this means that Objecgt A. in class FlexibleArray  function SetByKey sets the private string array vals(1) in class Flexible Array becomes "a"
    'A.SetByKey(2, "b") 'this means that Objecgt A. in class FlexibleArray function SetByKey sets the private string array vals(2) in class Flexible Array becomes "b"
    'A.SetByKey(3, "c") 'this means that Object A. in class FlexibleArray function SetByKey sets the private string array vals(3) in class Flexible Array becomes "c"
    'A.RenameKey(3,5) 'This means that object A in class FlexibleArray keys element 3 becomes 5 so keys(3) = 5
    
    ' Would print the char "c"
    
    'to try to use the functions:
    'A.SetByKey(1, "a") = 4
    'MsgBox (keys("a"))
    'test = A.SetByKey(1, "a") 'this means that Objecgt A. in class FlexibleArray  function SetByKey sets the private string array vals(1) in class Flexible Array becomes "a"
    'MsgBox (test)
    'test_rename = A.RenameKey(3, 5) 'This means that object A in class FlexibleArray keys element 3 becomes 5 so keys(3) = 5
    'MsgBox (test_rename)
    'Print A.GetByKey(5) 'Method not valid without suitable object
    
    
    'current problem:
    'the A.SetByKey expects a function or variable, even though it appears to be a function itself.
    
    End Sub
    

What I currently expect that this code replaces the my_array(3 to 4,5 to 9..) to an array that exists in/as the class module FlexibleArray, that is called when it needs to be used in the module. But Any clearifications would be greatly appreciated! :)


Solution

  • If the goal of redimensioning arrays is limited to a non-absurd number of levels, a simple function might work for you, say for 1 to 4 dimensions?

    You could pass the a string representing the lower and upper bounds of each dimension and that pass back the redimensioned array

    Public Function FlexibleArray(strDimensions As String) As Variant
    
        ' strDimensions = numeric dimensions of new array
        ' eg. "1,5,3,6,2,10" creates ARRAY(1 To 5, 3 To 6, 2 To 10)
    
        Dim arr()               As Variant
        Dim varDim              As Variant
        Dim intDim              As Integer
    
        varDim = Split(strDimensions, ",")
        intDim = (UBound(varDim) + 1) / 2
    
        Select Case intDim
            Case 1
                ReDim arr(varDim(0) To varDim(1))
            Case 2
                ReDim arr(varDim(0) To varDim(1), varDim(2) To varDim(3))
            Case 3
                ReDim arr(varDim(0) To varDim(1), varDim(2) To varDim(3), varDim(4) To varDim(5))
            Case 4
                ReDim arr(varDim(0) To varDim(1), varDim(2) To varDim(3), varDim(4) To varDim(5), varDim(6) To varDim(7))
        End Select
    
        ' Return re-dimensioned array
        FlexibleArray = arr
    End Function
    

    Test it by calling it with your array bounds

    Public Sub redimarray()
        Dim NewArray() As Variant
    
        NewArray = FlexibleArray("1,2,3,8,2,9")
    End Sub
    

    Should come back with an array looking like this in Debug mode watch value

    EDIT - Added Example of truly dynamic array of variant arrays

    Here's an example of a way to get a truly flexible redimensioned array, but I'm not sure it's what you're looking for as the firt index is used to access the other array elements.

    Public Function FlexArray(strDimensions As String) As Variant
    
        Dim arrTemp     As Variant
        Dim varTemp     As Variant
    
        Dim varDim      As Variant
        Dim intNumDim   As Integer
    
        Dim iDim        As Integer
        Dim iArr        As Integer
    
        varDim = Split(strDimensions, ",")
        intNumDim = (UBound(varDim) + 1) / 2
    
        ' Setup redimensioned source array
        ReDim arrTemp(intNumDim)
    
        iArr = 0
        For iDim = LBound(varDim) To UBound(varDim) Step 2
    
            ReDim varTemp(varDim(iDim) To varDim(iDim + 1))
            arrTemp(iArr) = varTemp
            iArr = iArr + 1
        Next iDim
    
        FlexArray = arrTemp
    End Function
    

    And if you look at it in Debug, you'll note the redimensioned sub arrays that are now accessible from the first index of the returned array

    FlexArray output