Array do not resize after ReDim VBA

Question

I was looking here for the answer to my problem but still, do not know how to solve it so I am refreshing the topic.

I have a primitive function that searches in the Worksheet (column A) the inputs to Userform.TextBox1, UserForm.Textbox2, etc. When a particular record is found, it should assign to an array the record itself and values from next 3 or 4 cells from the same row (each row ends with “End”). In this way, I will have the array of max 4 columns and as many rows as records will be found The first Do loop goes perfect but increasing the size variable (found records), so increasing the array’s row as I wanted, gives me the subscript out of range error. I spent on this a whole day but I do not see what I am missing. Here’s the code:

Sub test()
Dim arr() As Variant
Dim i, size As Integer
Dim back As String
Cells(1, 1).Select
i = 0
size = 0
Do Until ActiveCell.Value = UserForm1.TextBox1.Value
  ActiveCell.Offset(1, 0).Select
Loop
back = ActiveCell.Address
Do Until ActiveCell = "End"
    size = size + 1
    ReDim Preserve arr(1 To size, 1 To 4)
    Do Until ActiveCell.Value = "End"
        i = i + 1
        arr(size, i) = ActiveCell
        ActiveCell.Offset(0, 1).Select
    Loop
Loop
Range(back).Offset(1, 0).Select
Do Until ActiveCell.Value = UserForm1.TextBox2.Value
   ActiveCell.Offset(1, 0).Select
Loop
back = ActiveCell.Address
i = 0
Do Until ActiveCell = "End"
    size = size + 1
    ReDim Preserve arr(1 To size, 1 To 4)      '"Subscript out of range" error occurs here
    Do Until ActiveCell.Value = "End"
        i = i + 1
        arr(size, i) = ActiveCell
        ActiveCell.Offset(0, 1).Select
    Loop
Loop
End Sub

If you try to make [mcve] example of your code, most probably you will solve it yourself. Speaking of which, can you create one? :) — Vityata, May 24 '18 at 09:08
And while doing it, you might want to [avoid using `Select` and other `ActiveCell`](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba). — Vincent G, May 24 '18 at 09:16
Could you post some sample data? Also, could you specify at which line the error occurs? — Zev Spitz, May 24 '18 at 09:42
@1001001 Yes, this back-and-forth in the comments doesn't really add anything to the question. — Zev Spitz, May 24 '18 at 10:03

score 2 · Accepted Answer · answered May 24 '18 at 10:00

2

If you use Preserve keyword in an array Redim declaration it will only redimension the last of array's column. You need to reorganize your arr() array.

answered May 24 '18 at 10:00

1001001

236
1
6

Thank you. I have changed the data organizing in the array and it works. Nevertheless, I thought that ReDim in VBA is more flexible (or maybe I do not see this yet but my problem is solved). – vonski May 24 '18 at 10:18

Zev Spitz · Answer 2 · 2018-05-24T10:34:17.393

To restate your algorithm:

Search within the first column for the text in UserForm1.TextBox. This is the start row of a block
Each block continues until "End" appears in the first column
For each row in the block, you want the values of the cells in that row.
A cell which contains "End" marks the end of the values of the cells in that row.

I would suggest the following general improvements:

Use a data structure where you don't have to manage the number of elements, as this is very error-prone. Use a Scripting.Dictionary, an ArrayList or a VBA Collection.
You should not need to manipulate the selected cell. Define a Range and iterate over the cells in the Range.

Like this:

Dim text1 As String
text1 = "Alfa"
Dim text2 As String
text2 = "Kilo"

Dim results As New ArrayList

Dim rng As Range
Set rng = Worksheets("Sheet1").UsedRange

Dim row As Integer
For row = 1 To rng.Rows.Count
    Dim firstCellText As String
    firstCellText = rng(row, 1)

    'you might store the possible values in a Dictionary and use Dictionary.Exists for this check
    If firstCellText = text1 Or firstCellText = text2 Then

        Dim cellValues As ArrayList
        Set cellValues = New ArrayList 'this has to be on a separate line

        Dim cell As Range
        For Each cell In rng.Rows(row).Cells
            If cell = "End" Then Exit For
            cellValues.Add cell.Value
        Next
        results.Add cellValues
    End If
Next

@vonski That's your entire data sample? Five cells in a single row? — Zev Spitz, May 24 '18 at 09:56
Thank you for the answer. You asked for data sample: `Alfa NW America 273 End` and `Kilo SE Europe 321 End` I am searching for _Alfa_ and _Kilo_. Then the values of e.g. _NW_, _America_, and _273_ should be stored in one row of the array but the error occurs in the second `ReDim` - 29th row of code when `size` gets the value of 2. — vonski, May 24 '18 at 09:58
Basically yes, I try to figure out how to add a row into the array and it was not functioning. That is why I have prepared very basic data just to find the problem. — vonski, May 24 '18 at 10:08
@vonski I've updated my answer with some code. As you can see, the code is far simpler when you don't have to manage the size of the array. — Zev Spitz, May 24 '18 at 10:36

Array do not resize after ReDim VBA

2 Answers2