Adding to arrays and finding values in arrays

Question

I have 2 arrays: one that has values to search a document for (arr) and one that will put in associated cell addresses with the found values (arr2). I have no issues with arr, and have used it earlier in my code successfully.

With arr2, I want to find any cells that contain the values in arr, and add the cell address lRow amount of rows down from it to arr2, but ONLY if that address isn't already in arr2.

I found 2 SO answers that I'm trying to combine in order to solve my issue, but so far with no luck.

Excel VBA - adding an element to the end of an array

How to search for string in an array

My code below:

Sub Initiate()

Dim arr(3) As Variant
    arr(0) = "Value1"
    arr(1) = "Value2"
    arr(2) = "Value3"
    arr(3) = "Value4"
Dim arr2() As Variant
Dim Alc as String
Dim lRow as Long
Dim fVal as String

lRow = Activesheet.Cells(Activesheet.Rows.Count, 1).End(xlUp).Row

For Each element In arr

fVal = element

Set fRange = WA.Cells.Find(What:=fVal, LookIn:=xlFormulas _
    , LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False)

While Not fRange Is Nothing

    While Not IsInArray(fRange.Offset(lRow - 6, 0).Address(False, False), arr2)

        ReDim Preserve arr2(0 To UBound(arr2) + 1) As Variant

        arr2(UBound(arr2)) = fRange.Offset(lRow - 6, 0).Address(False, False)

    Set fRange = WA.Cells.Find(What:=fVal, LookIn:=xlFormulas _
    , LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False)

    Wend

Wend

Next element

Alc = "="

    For Each element In arr2

        Alc = Alc & element & "+"

    Next element

Alc = Left(Alc, Len(Alc) - 1)

MsgBox Alc

End Sub

Function IsInArray(stringToBeFound As String, arr2 As Variant) As Boolean

    IsInArray = (UBound(Filter(arr2, stringToBeFound)) > -1)

End Function

When run I get the following error:

On this line of code (within the IsInArray function):

IsInArray = (UBound(Filter(arr2, stringToBeFound)) > -1)

Any help is greatly appreciated!

Have you considered using a dictionary to replace `arr2`. If you store the unique value as the key, you can protect against duplication relatively easily. — basodre, Jun 22 '16 at 20:00

score 6 · Accepted Answer · answered Jun 22 '16 at 19:53

I don't like using Filter because it also matches on substrings, and often that's not what you want

Function IsInArray(stringToBeFound As String, arr2 As Variant) As Boolean

    IsInArray = Not IsError(Application.Match(stringToBeFound, arr2, 0))

End Function

Also:

ReDim Preserve arr2(0 To UBound(arr2) + 1) As Variant

should probably be:

ReDim Preserve arr2(0 To UBound(arr2) + 1)

score 4 · Answer 2 · answered Jun 22 '16 at 20:38

I figured I'd add in my comment here as an answer. (I hope it's not outside the scope of this question/forum). If you're looking to store unique values in a collection, I'm not sure that you can beat the performance of a dictionary.

Outside of the loop, you would declare and instantiate the Dictionary:

Dim oDict as Object
Set oDict = CreateObject("Scripting.Dictionary")

The code that you currently use to search arr2 then add the value if unique would be amended to look something like:

If Not oDict.Exists(fRange.Offset(lRow - 6), 0).Address(False, False)) then
    oDict(fRange.Offset(lRow - 6), 0).Address(False, False)) = ""
End If

Set fRange = WA.Cells.Find(What:=fVal, LookIn:=xlFormulas _
, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)

I don't know how many records you expect to be inserting or searching through, or how performant your software needs to be, but performance can be significantly different.

Adding to arrays and finding values in arrays

2 Answers2