JP has a good post about finding exact matches in arrays. I use a similar method. I Join the array with delimiters around all the values, then use Instr to see if it’s there. Here’s my code:
Function IsInArrayDK(vArr As Variant, sValueToCheck As String, _
Optional bMatch As Boolean = True) As Boolean
Dim bReturn As Boolean
Dim sWordList As String
Const sDELIM As String = "|"
'See if it's a match even if only a substring
bReturn = UBound(Filter(vArr, sValueToCheck)) > -1
'If a match and need exact
'If exact match not needed, the line above provides the return value
If bReturn And bMatch Then
'put pipes around all the values
sWordList = sDELIM & Join(vArr, sDELIM) & sDELIM
'See if the values with pipes is there
bReturn = InStr(1, sWordList, sDELIM & sValueToCheck & sDELIM) > 0
End If
IsInArrayDK = bReturn
End Function
To test, I filled an array with 100,000 random strings, picked one of the strings to find, then timed JP’s funciton, my function, and the non-optimized method. The non-optimized method simply loops through the array and checks for values.
Function IsInArrayLoop(vArr As Variant, sValueToCheck As String, _
Optional bMatch As Boolean = True) As Boolean
Dim bReturn As Boolean
Dim i As Long
For i = LBound(vArr) To UBound(vArr)
If bMatch Then
If vArr(i) = sValueToCheck Then
bReturn = True
Exit For
End If
Else
If InStr(1, vArr(i), sValueToCheck) > 0 Then
bReturn = True
Exit For
End If
End If
Next i
IsInArrayLoop = bReturn
End Function
The code to fill the array converts Rnd to a string and puts it in the array. Then I pick one of the values (first, middle, and last) as the value I want to check.
Sub FillArray(ByRef vArr As Variant, ByVal lPlace As Long, ByRef sValue As String)
Dim i As Long
For i = 1 To 100000
vArr(i) = CStr(Int(Rnd * 10000000))
If i = lPlace Then
sValue = vArr(i)
End If
Next i
End Sub
I used the same API timer that JP uses when he does speed tests.
Public Declare Function timeGetTime Lib "winmm.dll" () As Long
And finally, the sub to test loops through the early, middle, and late values-to-check and times them.
Sub TestArray()
Dim aNames(1 To 100000) As Variant
Dim i As Long
Dim bResult As Boolean
Dim lStart As Long, lEnd As Long
Dim sValueToCheck As String
Dim aPlace(1 To 3, 1 To 2) As Variant
Dim sTable As String, sRow As String
'name the tests and determine where the value to check is in the array
aPlace(1, 1) = "Value Early:": aPlace(1, 2) = 1
aPlace(2, 1) = "Value Middle:": aPlace(2, 2) = 50000
aPlace(3, 1) = "Value Late:": aPlace(3, 2) = 99999
'The results go in an html table
sRow = Tag(Tag("Milliseconds", "td") & Tag("JP", "td") & Tag("DK", "td") & Tag("Loop", "td"), "tr") & vbNewLine
sTable = sRow
For i = 1 To 3
sRow = Tag(aPlace(i, 1), "td")
FillArray aNames, aPlace(i, 2), sValueToCheck
lStart = timeGetTime
bResult = IsInArrayJP(aNames, sValueToCheck, True)
lEnd = timeGetTime
sRow = sRow & Tag(lEnd - lStart, "td")
lStart = timeGetTime
bResult = IsInArrayDK(aNames, sValueToCheck, True)
lEnd = timeGetTime
sRow = sRow & Tag(lEnd - lStart, "td")
lStart = timeGetTime
bResult = IsInArrayLoop(aNames, sValueToCheck, True)
lEnd = timeGetTime
sRow = sRow & Tag(lEnd - lStart, "td")
sTable = sTable & Tag(sRow, "tr") & vbNewLine
Next i
Debug.Print Tag(sTable, "table", , True)
End Sub
The results:
Milliseconds | JP | DK | Loop |
Value Early: | 53 | 53 | 0 |
Value Middle: | 48 | 53 | 11 |
Value Late: | 49 | 54 | 22 |
JP’s and mine are a wash and the loop is fastest. I guess I should just use that.