Excel VBA Storing Dynamic Arrays from Data Table

Posted on March 16, 2022

While doing a Google search for “Excel VBA store data in array” I came across a post Excel VBA – Storing Data in Arrays & Dynamic Arrays by Chester Tugwell at BluePecanTraining.com that gave me what I wanted. I won’t go into as much detail as Chester, but after reviewing the VBA code, I was able to make several changes that I believe is an improved version. Use my code if you like, which is at the end of this post, but if you did not understand any of the formulas, then refer back to the post made by Chester as he explains them in detail.

I don’t know Chester and he did not ask me to write this post with a link to his website. Chester, If you are reading this, then kudos to you for providing the initial code that this post is founded on and show me some love in the comments below or send a link my way.

Chester used a lot of specific variable names and even hard coded the value being searched in the VBA code. That always makes me cringe when people do that. However, Chester was most likely doing it for training purposes. I decided to use an InputBox to ask the user what to search for and store it as a string.

There were a few limitations to his code as well. It was not flexible enough or required modifications to the code before use in different situations.

For example, if you had a table of data with more columns than the 11 that Chester used, then you would not capture all the columns of data. This was easily fixed by getting and storing the max column variable and replacing the 11 with the max column variable. Since I did that, I also stored the max row variable to be consistent, although that was not necessary.

Also, Chester coded it to only look in the second column. I wanted the flexibility to look in any column. Chester already had a loop for each row, so this was solved by adding another loop for each column.

To finish off, I added a GoTo (see “nextRow”) within the loop where each row of data is stored in an array. This was necessary to jump to next row once a match was found. There is a possibility where the text being used may find a match in more than one column. I did not want to inadvertently have more than one copy of the same row. This resolves that problem by stopping the loop and progressing to the next row.

There are some other modifications I was thinking of, but I wanted to stop there and share while it is simple. I kept some of the notes from Chester with some modifications too.

Share any modifications that improve or suits your needs in a project that you are working on.

Here is the VBA code:

Sub Search_Data()
Dim sText As String
sText = UCase(InputBox("What would you like to search for?", "Search", sText))
Dim allData() As Variant
Dim curData As String
Dim matchArray() As Variant
Dim foundCounter As Long
Dim r As Long 'row
Dim c As Long 'column
Dim maxRow As Long 'max row
Dim maxCol As Long 'max column
'Store all data that is being searched in the allData array
allData = Range("a2").CurrentRegion
'Get max row and max column
maxRow = UBound(allData, 1)
maxCol = UBound(allData, 2)
'Starting in the second row of the database loop through the allData array
For r = 2 To maxRow
    For c = 1 To maxCol
        curData = UCase(allData(r, c)) 'CStr
        'If current row and column contains a value equal to (case-insensitive)...
        If InStr(curData, sText) <> 0 Then
            '...increase foundCounter by 1
            foundCounter = foundCounter + 1
            'Redimension the match array with each instance match
            ReDim Preserve matchArray(1 To maxCol, 1 To foundCounter)
            'Start at column 1 and go to max column to populate the matchArray array
            For copyCol = 1 To maxCol
            'The matchArray array equals the row that matches
                  matchArray(copyCol, foundCounter) = allData(r, copyCol)
            Next copyCol
            'If match is found, then no need to search next column.  Go to next row.
            GoTo nextRow
        End If
    Next c
nextRow:
Next r
'If nothing is found, then exit sub
If foundCounter = 0 Then
    MsgBox "No matches found."
    Exit Sub
End If
'Add a new sheet
Worksheets.Add
'Add the headings in the first row from the active worksheet
Range(Cells(1, 1), Cells(1, maxCol)) = allData
'Transpose the match array onto the new sheet
Range("A2", Range("A2").Offset(foundCounter - 1, maxCol - 1)) = Application.Transpose(matchArray)
'Autofit columns
Columns.AutoFit
End Sub