Excel VBA - Dynamic Array not Working

I am trying to make an array that stores all of the values in Column A from "Workbook B" so I can then reference and see if a cell's value is in that array in Column A from "Workbook A".

This is what I have so far for that array:

Dim StrArray() As String Dim TotalRows As Long Dim X As Long Workbooks.Open Filename:="filepath", ReadOnly:=True With Workbooks("file").Worksheets("sheet") TotalRows = Rows(Rows.Count).End(xlUp).Row ReDim StrArray(1 To TotalRows) For X = 2 To TotalRows StrArray(X) = Cells(X, 1).Value Next X End With 

This part of the array works just fine, I confirmed it's working correctly by displaying all of the values in the array in an MsgBox. The problem comes when I try to reference this array in "Workbook A" to check if a cell's value is in that array.

This is what I have for that code:

For RowCounter = LastRow To 1 Step -1 If IsInArray(Range("B" & RowCounter).Value, StrArray) Then Range("K" & RowCounter).Value = "MATCH" End If Next RowCounter Workbooks("file").Close SaveChanges:=False 

Here is the function I am using:

Public Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean Dim i For i = LBound(arr) To UBound(arr) If arr(i) = stringToBeFound Then IsInArray = True Exit Function End If Next i IsInArray = False End Function 

It does not put the "MATCH" value in column K. I tried troubleshooting by putting a MsgBox in the If statement to see if it's matching the value to the array, and it gave me a never ending loop of the MsgBox. If it matters, there is currently text in column K that this code is writing over.

2 Answers

If I were solving such a problem, I would refuse to use an array in favor of the built-in MATCH method:

Sub markCellsIfPresent() Const DICTIONARY_WORKBOOK As String = "filepath" Const DICTIONARY_WORKSHEET = "sheet" Dim wsActive As Worksheet Dim rValidate As Range Dim oCell As Range Dim wbDictionary As Workbook Dim wsDictionary As Worksheet Dim rDictionary As Range Dim searchRes As Variant Set wsActive = ActiveSheet Set rValidate = Application.Intersect(wsActive.UsedRange, wsActive.Columns(2)) Application.ScreenUpdating = False Set wbDictionary = Workbooks.Open(Filename:=DICTIONARY_WORKBOOK, ReadOnly:=True) Set wsDictionary = wbDictionary.Worksheets(DICTIONARY_WORKSHEET) Set rDictionary = Application.Intersect(wsDictionary.UsedRange, wsDictionary.Columns(1)) For Each oCell In rValidate.Cells searchRes = Application.Match(oCell.Text, rDictionary, 0) If Not IsError(searchRes) Then Rem oCell in column B (2), we set mark to column K (11), so offset is 11-2=9 oCell.Offset(0, 9).value = "MATCH" End If Next oCell wbDictionary.Close Application.ScreenUpdating = True End Sub 

Of course, the real code should be longer - for example, you need to check if the workbook "filepath" exists and is open, if it has a sheet named "sheet" in it, if there is data there, and more

This code solves the problem, but does not answer your question about using an array for this purpose.

The array code will be a bit longer because we need a helper procedure to fill it and a function to search it.

Sub markCellsWithArray() Const DICTIONARY_WORKBOOK As String = "filepath" Const DICTIONARY_WORKSHEET = "sheet" Dim wsActive As Worksheet Dim rValidate As Range Dim oCell As Range Dim wbDictionary As Workbook Dim wsDictionary As Worksheet Dim rDictionary As Range Dim StrArray As Variant Set wsActive = ActiveSheet Set rValidate = Application.Intersect(wsActive.UsedRange, wsActive.Columns(2)) Application.ScreenUpdating = False Set wbDictionary = Workbooks.Open(Filename:=DICTIONARY_WORKBOOK, ReadOnly:=True) Set wsDictionary = wbDictionary.Worksheets(DICTIONARY_WORKSHEET) Set rDictionary = Application.Intersect(wsDictionary.UsedRange, wsDictionary.Columns(1)) Rem Collect values from dictionary to array (skip empty cells) StrArray = Array() For Each oCell In rDictionary.Cells If Not Trim(oCell.Text) = vbNullString Then Call AddIfNeed(Trim(oCell.Text), StrArray) Next oCell wbDictionary.Close Application.ScreenUpdating = True Rem Mark cells in active sheet For Each oCell In rValidate.Cells If IsInArray(Trim(oCell.Text), StrArray) Then oCell.Offset(0, 9).value = "MATCH" End If Next oCell End Sub Sub AddIfNeed(ByVal key As String, aData As Variant) Dim l&, r&, m&, N&, i& l = LBound(aData) r = UBound(aData) + 1 N = r While (l < r) m = l + Int((r - l) / 2) If aData(m) < key Then l = m + 1 Else r = m Wend If r = N Then ' Add to end of set ReDim Preserve aData(0 To N) aData(N) = key ElseIf aData(r) = key Then ' Already in the set, do nothing Else ' Insert to set in correct place ReDim Preserve aData(0 To N) For i = N - 1 To r Step -1 aData(i + 1) = aData(i) Next i aData(r) = key End If End Sub Private Function IsInArray(ByVal stringToBeFound As String, aData As Variant) As Boolean Dim l&, r&, m&, N&, i& l = LBound(aData) r = UBound(aData) + 1 N = r While (l < r) m = l + Int((r - l) / 2) If aData(m) < stringToBeFound Then l = m + 1 Else r = m Wend If r = N Then ' Add to end of set IsInArray = False Else IsInArray = (aData(r) = stringToBeFound) ' TRUE if found End If End Function 

The trick of the helper code is to use a binary search, which is much faster than the linear search you use when going through an unsorted array element by element.

To implement this trick without helper code, you could use a Dictionary object - it's all there already and you don't have to worry about your own implementation of the classic algorithms.

However, test both procedures on sufficiently large datasets and see how the array algorithm outperforms the built-in MATCH method.

JohnSUN's code works well, but I also did figure out how to get the array path to work.

Workbooks.Open Filename:="filepath", ReadOnly:=True With Workbooks("filename").Worksheets("sheetname") TotalRows = Rows(Rows.Count).End(xlUp).Row ReDim StrArray(1 To TotalRows) For X = 2 To TotalRows StrArray(X) = Cells(X, 1).Value Next X End With Workbooks("filename").Close SaveChanges:=False ActWS.Activate 'Adds MATCH to applicable rows For RowCounter = LastRow To 1 Step -1 If IsInArray(Range("B" & RowCounter).Value, StrArray) Then Range("K" & RowCounter).Value = "MATCH" End If Next RowCounter End If 

The problem was when "MATCH" was being applied, it was putting it in the wrong file. So I had to reactivate the file I wanted it in before the code was executed.