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.