a.t.
a.t.

Reputation: 2808

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! :)

Upvotes: 2

Views: 1693

Answers (2)

dbmitch
dbmitch

Reputation: 5386

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

Upvotes: 1

Uri Goren
Uri Goren

Reputation: 13682

Sounds like you are abusing arrays for something they weren't meant to do with a ton of memory copying.

What you want is to write your own Class (Right click the code folder ->Insert ->Class Module), let's call it FlexibleArray.

Your class code would be something like this:

Private keys() as Integer
Private vals() as String
Private i as Integer

Public Sub Init(ByVal n as Integer)
   Redim keys(n)
   Redim vals(n)
   For i = 1 to n
        keys(i) = i
   Next i
End Sub

Public Function GetByKey(ByVal key As Integer) As String
   GetByKey = vals(Application.Match(key, keys, False))
End Function

Public Sub SetByKey(ByVal key As Integer, ByVal val As String)
   vals(Application.Match(key, keys, False)) = val
End Sub

Public Sub RenameKey(ByVal oldName As Integer, ByVal newName As Integer)
   keys(Application.Match(oldName, keys, False))=newName
End Sub

Now you can rename whatever key you want:

Dim A as New FlexibleArray
A.Init(3)
A.SetByKey(1, "a")
A.SetByKey(2, "b")
A.SetByKey(3, "c")
A.RenameKey(3,5)
Print A.GetByKey(5)
' Would print the char "c"

Extending it to integer ranges (like your example) is pretty straight forward

Upvotes: 1

Related Questions