Partial exists in dictionary

I m looking for a way to check if a value included in a dictionary, Excel - VBA. However, simple dict.Exists("") is not the right approach in this situation because the searching value with not be exactly the same with the value in the dictionary.

For example I m look for the word apple in the dictionary which includeds the phrase fruit apple. So apple included in the dictionary as fruit apple. Case sensitivity much be avoided.

Currently, I looping the dictionary which is time consuming.

Is ther any additions like dict.Exists("*apple*")

Any ideas?

Sounds like a perfect job for the (relatively unknown) Filter() function.

Sub Test()

Dim Dict As Object: Set Dict = CreateObject("Scripting.Dictionary")

Dict.Add "Apples", "Found You!"
Dict.Add "Banana", 2
Dict.Add "Cherry", 3
Dict.Add "Date", 4
Dict.Add "Elderberry", 5

r_out = Filter(Dict.Keys, "apple", 1, 1)
If UBound(r_out) > -1 Then
    'Do something with r_out, which is an array of all matched keys
    'For example, traverse filtered keys and return values:
    For i = 0 To UBound(r_out)
        Debug.Print Dict(r_out(i))
    Next
Else
    'Something if no matches are found
    Debug.Print "Bummer"
End If

End Sub

4 Parameters:

• One-dimensional array of strings which Dict.Keys can provide;
• A string to search for (case insensitive so don't worry here);
• A boolean (or equivalent, 1) to tell the function we want to return values that include the string;
• An integer 1 (vbTextCompare) to tell the function we want to compare text.

I'm unsure what you want to do next...

The Dictionary.Keys Method will return an Array that contains all of the Keys.

Excel's MATCH function allows you to search an Array (and can be called as Application.Match in VBA). This supports Wildcards, and is not Case Sensitive — however, note that it only returns a single result, even if multiple keys in the Dictionary match the pattern.

Combining the two:

Dim vArr AS Variant, vMatch As Variant
vArr = dict.keys
vMatch = Application.Match("*apple*", vArr, 0)
If IsError(vMatch) Then
    MsgBox "Key Not Found", vbCritical
Else
    MsgBox vArr(vMatch-1), vbInformation 'the -1 is because the Array is Zero-Indexed, but Match returns One-Indexed results
End If

I like @JvdV answer and it's probably the simplest to implement while also being independent of the application.

My answer will focus on improving the speed by using the Like operator and I will provide a comparison with the other answers.

The idea is to iterate all keys with something like:

For Each tkey In Dict
    If tkey Like "*apple*" Then
       ...
    End If
Next tkey

We will need a support function to adapt patterns if we need case-insensitive comparisons. For example If tkey Like "*apple*" Then is case-sensitive and we need If tkey Like "*[Aa][Pp][Pp][Ll][Ee]*" Then for case-insensitive comparisons.

To adapt patterns, we need the following support function:

Public Function CaseInsensitivePattern(ByRef pattern As String) As String
    Dim chars As Long: chars = Len(pattern)
    Dim i As Long
    Dim j As Long
    Dim chL As String
    Dim chU As String
    '
    If chars = 0 Then Exit Function
    CaseInsensitivePattern = Space$(chars * 4) 'Init Buffer
    '
    j = 1
    For i = 1 To chars
        chL = LCase$(Mid$(pattern, i, 1))
        chU = UCase$(chL)
        If chL = chU Then
            Mid$(CaseInsensitivePattern, j) = chL
            j = j + 1
        Else
            Mid$(CaseInsensitivePattern, j) = "[" & chU & chL & "]"
            j = j + 4
        End If
    Next i
    CaseInsensitivePattern = Left$(CaseInsensitivePattern, j - 1)
End Function

In order to test this on lots of items, I will use VBA-FastDictionary instead of Scripting.Dictionary. Adding 1 million text keys with Scripting.Dictionary takes about 23 seconds on my computer while Fast Dictionary only takes about 0.65 seconds. There is a benchmarking section if you want more details. If you don't mind waiting to add the items then continue to use Scripting.Dictionary.

Here is the comparison:

Sub TestSpeed()
    Dim i As Long
    Const iterations As Long = 1000000
    Dim t As Double
    Dim dict As New Dictionary
    Dim v As Variant
    Dim coll As Collection
    '
    'Add key-item pairs
    For i = 1 To iterations
        dict.Add "Key " & i, i
        If i Mod iterations \ 10 = 0 Then dict.Add "apple " & i, i
    Next i
    Debug.Print "Results in seconds"
    Debug.Print "------------------"
    '
    'Filter solution
    Dim arr As Variant
    t = Timer
    arr = Filter(dict.Keys, "test", True, vbTextCompare)
    Debug.Print "Filter on Dict.Keys: " & Round(Timer - t, 3)
    '
    'Match solution
    Dim vMatch As Variant
    t = Timer
    vMatch = Application.Match("*apple*", dict.Keys, 0)
    Debug.Print "Match on Dict.Keys: " & Round(Timer - t, 3)
    '
    'Pattern match case-sensitive
    Dim pattern As String: pattern = "*apple*"
    Set coll = New Collection
    t = Timer
    For Each v In dict
        If v Like pattern Then coll.Add v
    Next v
    Debug.Print "Pattern match case-sensitive on Dict (implicit keys): " & Round(Timer - t, 3)
    '
    'Pattern match case-insensitive
    Dim patternI As String: patternI = CaseInsensitivePattern(pattern)
    Set coll = New Collection
    t = Timer
    For Each v In dict
        If v Like patternI Then coll.Add v
    Next v
    Debug.Print "Pattern match case-insensitive on Dict (implicit keys): " & Round(Timer - t, 3)
    '
    'Pattern match case-sensitive on keys array
    Set coll = New Collection
    t = Timer
    For Each v In dict.Keys
        If v Like pattern Then coll.Add v
    Next v
    Debug.Print "Pattern match case-sensitive on Dict.Keys: " & Round(Timer - t, 3)
End Sub

On my VBA7 x64 Win computer I get the following results in the Immediate window:

Results in seconds
------------------
Filter on Dict.Keys: 0.309
Match on Dict.Keys: 0.133
Pattern match case-sensitive on Dict (implicit keys): 0.074
Pattern match case-insensitive on Dict (implicit keys): 0.133
Pattern match case-sensitive on Dict.Keys: 0.098

Note that the Match approach only returns the first found result while all others return all matches in either an array or a collection result.