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:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 | 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 |