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-16 10:56:32Z

4

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

edited Aug 16, 2012 at 10:56

answered Aug 15, 2012 at 22:51

mkingston

2,74820 silver badges27 bronze badges

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

4 Comments

Siddharth Rout Over a year ago

+ 1 for going the extra mile ;)

Evert Van Steen Over a year ago

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: msdn.microsoft.com/en-us/library/x397t1yt%28v=vs.71%29.aspx

mkingston Over a year ago

@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 Over a year ago

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.

Community · Accepted Answer · 2018-05-08 21:48:18Z

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.

Siddharth Rout · Accepted Answer · 2012-08-15 22:52:57Z

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, 2012 at 22:52

Siddharth Rout

150k18 gold badges212 silver badges258 bronze badges

8 Comments

mkingston Over a year ago

Looks like OP currently has a fixed second dimension, he could just transpose his array so he's redimming the second dimension.

Siddharth Rout Over a year ago

Yes he can do that but for a newbie that can really be a pain.

mkingston Over a year ago

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

Siddharth Rout Over a year ago

Since you mentioned it first, i would recommend adding an example in your post on how to do that :)

mkingston Over a year ago

I put my money where my mouth was and got beaten to it by Doug! Haha!

|

Collectives™ on Stack Overflow

Use findnext to fill multidimensional array VBA Excel

3 Answers 3

4 Comments

Comments

8 Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

3 Answers 3

4 Comments

Comments

8 Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related