Add range of data/cells in dynamic multidimensional array vba

Question

I would like to be able to add some range of data in a dynamic multidimensional array without using a double loop that screens each element of the array. But I don't know if it is possible. By double loop, I mean such a code (this is only an example):

Dim Films(1 To 5, 1 To 2) As String
Dim i As Integer, j As Integer 
For i = 1 To 5
     For j = 1 To 2
         Films(i, j) = Cells(i, j).Value
     Next j
Next i

I am using VBA 2010. I know how many rows my array has, but the number of columns is variable.

Here is my code :

Sub DRS(Item)
    'item is a name to search for in a specific range
    Dim SrcRange() As Variant
    Dim cell3 As Range
    Dim n As Integer, m As Integer

    SrcRange() = Array()
    ReDim SrcRange(45, 0)
    m = -1
    n = 0
    With Sheets("X")
        For Each cell3 In .Range("I13:AG" & .Cells(1, Columns.Count).End(xlToRight).Column)
        'the range ("I13:AG...") contains names, and some will match with "item"
            m = m + 1
            If Len(cell3.Value) > 0 And cell3 = Item Then 
                SrcRange(0, n) = .Range(m + 8 & "30:" & m + 8 & "75")
                'the previous line **should** add a whole range of cells (which contain numbers, one by cell) in a colum of the array, but this is the line that doesn't work.
                n = n + 1 
                ReDim Preserve SrcRange(UBound(SrcRange), n)
            End If
            Next cell3
    End With
End Sub

I already tried those::

SrcRange(:, n) = .Range(m + 8 & "30:" & m + 8 & "75")
SrcRange(0:45, n) = .Range(m + 8 & "30:" & m + 8 & "75")
SrcRange(, n) = .Range(m + 8 & "30:" & m + 8 & "75")

but no one worked.

Is there a way or a formula that would allow me to add a full range of cells to each column of the array, or am I obliged to use a double loop to add the elements one by one?

What exactly do you want to do? I think what you want is doable but can you illustrate a sample data and how you want it passed to the array? — L42
– L42, Commented Apr 15, 2015 at 8:15
I would like to create an array that would dynamically update when data are reviewed. More precisely, when I add a column in the spreadsheet "X", I would like it to be added as a new column in the array. This array will be used to set a chart, but I only gave the code for the array, so it is more readable. — Mr.Jack1
– Mr.Jack1, Commented Apr 15, 2015 at 9:29

Comintern · Accepted Answer · 2015-04-16 03:20:49Z

1

I'm guessing that this Range...

.Range("I13:AG" & .Cells(1, Columns.Count).End(xlToRight).Column)

...should actually be xlToLeft instead of xlToRight (xlToRight will always return I13:AG16384).

I'm also not entirely sure what the m + 8 & "30:" & m + 8 & "75" is supposed to be evaluating to, because you increment the variable m each time through the loop, and it gives you ranges like 930:975. I'll take a stab in the dark and assume that the m + 8 is supposed to be the column that you found the item in.

That said, the .Value property of a Range object will just give you a 2 dimensional array. There isn't really any reason to build an array - just build a range and then worry about getting the array out of it when you're done. To consolidate the range (you only get the first area if you grab its Value), just copy and paste it to a temporary Worksheet, grab the array, then delete the new sheet.

Sub DRS(Item)
    'item is a name to search for in a specific range
    Dim SrcRange() As Variant
    Dim found As Range
    Dim cell3 As Range

    With Sheets("X")
        For Each cell3 In .Range("I13:AG" & .Cells(1, Columns.Count).End(xlToLeft).Column)
            'the range ("I13:AG...") contains names, and some will match with "item"
            If Len(cell3.Value) > 0 And cell3.Value = Item Then
                If Not found Is Nothing Then
                    Set found = Union(.Range(.Cells(30, cell3.Column), .Cells(75, cell3.Column)), found)
                Else
                    Set found = .Range(.Cells(30, cell3.Column), .Cells(75, cell3.Column))
                End If
            End If
        Next cell3
    End With

    If Not found Is Nothing Then
        Dim temp_sheet As Worksheet
        Set temp_sheet = ActiveWorkbook.Sheets.Add
        found.Copy
        temp_sheet.Paste
        SrcRange = temp_sheet.UsedRange.Value
        Application.DisplayAlerts = False
        temp_sheet.Delete
        Application.DisplayAlerts = True
    End If
End Sub

answered Apr 16, 2015 at 3:20

Comintern

22.3k6 gold badges36 silver badges83 bronze badges

Sign up to request clarification or add additional context in comments.

3 Comments

Mr.Jack1 Over a year ago

Thanks for your answer! Concerning your first remark, it is XlToRight and not XlToLeft, because when a column is added, it is on the right of the sheet. But I know this makes the macro slower, because as you mentionned, it goes until the 16384th column, so I will improve it later by just entering a defined number of columns instead of letting it search until the right end of the sheet. You're right, the m+8 was there to change the column each time that it looks for item, but I didn't know it was possible to set cell3.Column, which suits much better. Your solution works really fine.

Mr.Jack1 Over a year ago

Just one thing that I noticed, when SrcRange = temp_sheet.UsedRange.Value executes, it inserts the data into SrcRange from 1 to 46. Wouldn't there exist a way to insert the data from 0 to 45 ?

Comintern Over a year ago

@Mr.Jack1 - Unfortunately, no - the arrays returned by ranges always have a base of 1 (to match the worksheet indexing).

Collectives™ on Stack Overflow

Add range of data/cells in dynamic multidimensional array vba

1 Answer 1

3 Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

3 Comments

Your Answer

Sign up or log in

Post as a guest

Related