Use findnext to fill multidimensional array VBA Excel

Question

My question actually concerns a matter that extends on EXCEL VBA Store search results in an array?

Here Andreas tried to search through a column and save hits to an array. I am trying the same. But differing in that on (1) finding a value (2) I want to copy different value types from (3) cells in the same row as where the searched value was found, (4) to a two dimensional array.

So the array would (conceptually) look something like:

Searchresult.1st SameRow.Cell1.Value1 SameRow.Cell2.Value2 SameRow.Cell3.Value3
Searchresult.2nd SameRow.Cell1.Value1 SameRow.Cell2.Value2 SameRow.Cell3.Value3
Searchresult.3rd SameRow.Cell1.Value1 SameRow.Cell2.Value2 SameRow.Cell3.Value3

Etc.

The code I use looks like this:

Sub fillArray()

Dim i As Integer
Dim aCell, bCell As Range
Dim arr As Variant

i = 0 

Set aCell = Sheets("Log").UsedRange.Find(What:=("string"), _
                    LookIn:=xlValues, _
                    LookAt:=xlWhole, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlNext, _
                    MatchCase:=False, _
                    SearchFormat:=False)

If Not aCell Is Nothing Then
    Set bCell = aCell
    ReDim Preserve arr(i, 5)
    arr(i, 0) = True 'Boolean
    arr(i, 1) = aCell.Value 'String
    arr(i, 2) = aCell.Cells.Offset(0, 1).Value 
    arr(i, 3) = aCell.Cells.Offset(0, 3).Value
    arr(i, 4) = aCell.Cells.Offset(0, 4).Value
    arr(i, 5) = Year(aCell.Cells.Offset(0, 3).Value)

    i = i + 1

    Do While exitLoop = False
            Set aCell = Sheets("Log").UsedRange.FindNext(after:=aCell)

            If Not aCell Is Nothing Then
                If aCell.Address = bCell.Address Then Exit Do
                'ReDim Preserve arrSwUb(i, 5)
                    arr(i, 0) = True
                    arr(i, 1) = aCell.Value
                    arr(i, 2) = aCell.Cells.Offset(0, 1).Value
                    arr(i, 3) = aCell.Cells.Offset(0, 3).Value
                    arr(i, 4) = aCell.Cells.Offset(0, 4).Value
                    arr(i, 5) = Year(aCell.Cells.Offset(0, 3).Value)

                    i = i + 1
            Else
                exitLoop = True
            End If
    Loop


End If

End Sub

It seems to go wrong on redimming the array in the loop. I get a Subscript out of range error. I guess I can't redim the array as I'm doing now, but I can't figure out how it is supposed to be done.

I’d be greatful for any clues as to what I’m doing wrong.

mkingston · Accepted Answer · 2012-08-16T10:56:32.440

ReDim Preserve can only resize the last dimension of your array: http://msdn.microsoft.com/en-us/library/w8k3cys2(v=vs.71).aspx

From the above link:

Preserve

Optional. Keyword used to preserve the data in the existing array when you change the size of only the last dimension.

Edit: That's not enormously helpful, is it. I suggest you transpose your array. Also, those error messages from the array functions are AWFUL.

At the suggestion of Siddarth, try this. Let me know if you have any problems:

Sub fillArray()
    Dim i As Integer
    Dim aCell As Range, bCell As Range
    Dim arr As Variant

    i = 0
    Set aCell = Sheets("Log").UsedRange.Find(What:=("string"), _
                                             LookIn:=xlValues, _
                                             LookAt:=xlWhole, _
                                             SearchOrder:=xlByRows, _
                                             SearchDirection:=xlNext, _
                                             MatchCase:=False, _
                                             SearchFormat:=False)
    If Not aCell Is Nothing Then
        Set bCell = aCell
        ReDim Preserve arr(0 To 5, 0 To i)
        arr(0, i) = True 'Boolean
        arr(1, i) = aCell.Value 'String
        arr(2, i) = aCell.Cells.Offset(0, 1).Value
        arr(3, i) = aCell.Cells.Offset(0, 3).Value
        arr(4, i) = aCell.Cells.Offset(0, 4).Value
        arr(5, i) = Year(aCell.Cells.Offset(0, 3).Value)
        i = i + 1
        Do While exitLoop = False
            Set aCell = Sheets("Log").UsedRange.FindNext(after:=aCell)
            If Not aCell Is Nothing Then
                If aCell.Address = bCell.Address Then Exit Do
                ReDim Preserve arrSwUb(0 To 5, 0 To i)
                arr(0, i) = True
                arr(1, i) = aCell.Value
                arr(2, i) = aCell.Cells.Offset(0, 1).Value
                arr(3, i) = aCell.Cells.Offset(0, 3).Value
                arr(4, i) = aCell.Cells.Offset(0, 4).Value
                arr(5, i) = Year(aCell.Cells.Offset(0, 3).Value)
                i = i + 1
            Else
                exitLoop = True
            End If
        Loop
    End If
End Sub

Note: in the declarations, you had:

Dim aCell, bCell as Range

Which is the same as:

Dim aCell as Variant, bCell as Range

Some test code to demonstrate the above:

Sub testTypes()

    Dim a, b As Integer
    Debug.Print VarType(a)
    Debug.Print VarType(b)

End Sub

Aah yes, so that's how that works (and it does work :)! I knew I was close, but I just couldn't get there. It had me breaking my head for 2 days. I truly am thankful for your help. On a sidenote are you sure about that Dimming works like that? I always thought that on declaration separating variables with a comma makes them all the same type: http://msdn.microsoft.com/en-us/library/x397t1yt%28v=vs.71%29.aspx — Evert Van Steen, Aug 16 '12 at 09:06
@EvertVanSteen happy to help. I think in VB (not VBA) it works like that. See my edit for a piece of sample code which will show you that the variables types are different. — mkingston, Aug 16 '12 at 10:56
One more thing, you'll need the immediate window up to display the output from a debug.print statement. Press ctrl+g to display this. — mkingston, Aug 16 '12 at 10:56

score 3 · Answer 2 · edited May 08 '18 at 21:48

Here's an option that assumes you can dimension the array at the beginning. I used a WorsheetFunction.Countif on the UsedRange for "string," which seems like it should work:

Option Explicit

    Sub fillArray()

    Dim i As Long
    Dim aCell As Range, bCell As Range
    Dim arr() As Variant
    Dim SheetToSearch As Excel.Worksheet
    Dim StringCount As Long

    Set SheetToSearch = ThisWorkbook.Worksheets("log")
    i = 1

    With SheetToSearch
        StringCount = Application.WorksheetFunction.CountIf(.Cells, "string")
        ReDim Preserve arr(1 To StringCount, 1 To 6)
        Set aCell = .UsedRange.Find(What:=("string"), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)

        If Not aCell Is Nothing Then
            arr(i, 1) = True    'Boolean
            arr(i, 2) = aCell.Value    'String
            arr(i, 3) = aCell.Cells.Offset(0, 1).Value
            arr(i, 4) = aCell.Cells.Offset(0, 3).Value
            arr(i, 5) = aCell.Cells.Offset(0, 4).Value
            arr(i, 6) = Year(aCell.Cells.Offset(0, 3).Value)
            Set bCell = aCell
            i = i + 1

            Do Until i > StringCount
                Set bCell = .UsedRange.FindNext(after:=bCell)
                If Not bCell Is Nothing Then
                    arr(i, 1) = True    'Boolean
                    arr(i, 2) = bCell.Value    'String
                    arr(i, 3) = bCell.Cells.Offset(0, 1).Value
                    arr(i, 4) = bCell.Cells.Offset(0, 3).Value
                    arr(i, 5) = bCell.Cells.Offset(0, 4).Value
                    arr(i, 6) = Year(bCell.Cells.Offset(0, 3).Value)
                    i = i + 1
                End If
            Loop
        End If
    End With

    End Sub

Note that I fixed some issues in your declarations. I added Option Explicit, which forces you to declare your variables - exitLoop was undeclared. Now both aCell and bCell are ranges - previously only bCell was (scroll down to "Pay Attention To Variables Declared With One Dim Statement"). I also created a worksheet variable and surrounded it in a With statement. Also, I started both dimensions of the array at 1 because... well because I wanted to I guess :). I also simplified some of the loop exiting logic - I don't think you needed all that to tell when to exit.

score 2 · Answer 3 · answered Aug 15 '12 at 22:52

2

You cannot Redim Preserve a multi dimensional array like this. In a multidimensional array, you can change only the last dimension when you use Preserve. If you attempt to change any of the other dimensions, a run-time error occurs. I would recommend reading this msdn link

having said that I can think of 2 options

Option 1

Store the results in a new temp sheet

Option 2

Declare a 1D array and then concatenate your results using a unique delimiter for example "#Evert_Van_Steen#"

At the top of the code

Const Delim As String = "#Evert_Van_Steen#"

Then use it like this

ReDim Preserve arr(i)

arr(i) = True & Delim & aCell.Value & Delim & aCell.Cells.Offset(0, 1).Value & Delim & _
aCell.Cells.Offset(0, 3).Value & Delim & aCell.Cells.Offset(0, 4).Value & Delim & _
Year(aCell.Cells.Offset(0, 3).Value)

answered Aug 15 '12 at 22:52

Siddharth Rout

147,039
17
206
250

Looks like OP currently has a fixed second dimension, he could just transpose his array so he's redimming the second dimension. – mkingston Aug 15 '12 at 23:02
Yes he can do that but for a newbie that can really be a pain. – Siddharth Rout Aug 15 '12 at 23:04
Frankly, I just put that comment there in case he only reads your answer and finds it to be correct (which he should)- but give the man some credit! He's gotten this far, I'm sure he'll manage, and if you're reading this OP, you're welcome to ask :). – mkingston Aug 15 '12 at 23:17
Since you mentioned it first, i would recommend adding an example in your post on how to do that :) – Siddharth Rout Aug 15 '12 at 23:22
I put my money where my mouth was and got beaten to it by Doug! Haha! – mkingston Aug 15 '12 at 23:39
Is it that obvious I'm a newb? Given I have only started coding since a couple of weeks, I think I am making great progress :) And your comments here greatly helped my understanding of arrays. Seems logical now you can only change the last dimension. Just never stopped to think of it. I'm not sure I want to transpose the array though. Since it would be flipped in respect of the source, I am afraid it would hurt my brain when using the array further down the line ;) Unless there are particular reasons that is actually the better option? – Evert Van Steen Aug 16 '12 at 09:21
The second option that I gave is far more easier to understand when compared to transposing arrays. But if you can understand on how to transpose the array then nothing like that ;) – Siddharth Rout Aug 16 '12 at 09:28
Oh wait, you're right. I do need to transpose it. I didn't see it because I was accidentally using a transposing view on the array. Thanks. – Evert Van Steen Aug 16 '12 at 12:05

Use findnext to fill multidimensional array VBA Excel

3 Answers3

Linked