Using InStr function to count how many words contain ALL specific letters of a unique word-CodePudding

Need to create a macro that would count ALL words in a large data set, that contain ALL letters of a specific word. It can contain letters that my word does not have but MUST contain at least all letters my word has. For example, if unique word is "Orchids", the word doctorship would count.

Edit: All data is located to row 252679 in column A

I'm trying to see if I am on the right track, I am also not sure if my code excludes from counting duplicate letters.

So far I've come up:

Dim count As Long
Dim word As String
Dim row As Long

count = 0

    For row = 2 To 252679
        word = Cells(row, 1).Value
        
    If InStr(1, word, "a", vbTextCompare) Then
    If InStr(1, word, "c", vbTextCompare) Then
    If InStr(1, word, "a", vbTextCompare) Then
    If InStr(1, word, "d", vbTextCompare) Then
    If InStr(1, word, "e", vbTextCompare) Then
    If InStr(1, word, "m", vbTextCompare) Then
    If InStr(1, word, "y", vbTextCompare) Then
        count = count   1
End If
End If
End If
End If
End If
End If
End If
Next row
MsgBox "CountWordsMatchingALL = " & count

CodePudding user response：

I don't know if it's possible, but could I suggest you a PowerQuery solution?

CodePudding user response：

You could do something like this:

Sub Tester()

    Debug.Print HasAllLetters("Dog", "done")
    
    Debug.Print HasAllLetters("Cat", "Scatter")

End Sub


'return true if all letters in `myWord` are present in `testWord`
Function HasAllLetters(ByVal myWord As String, ByVal testWord As String) As Boolean
    Dim i As Long
    'converting to lower case is faster than using `vbTextCompare`
    testWord = LCase(testWord) 'case-insensitive
    myWord = LCase(myWord)
    For i = 1 To Len(myWord)
        If Not InStr(testWord, Mid(myWord, i, 1)) > 0 Then Exit For
    Next i
    HasAllLetters = (i = Len(myWord)   1) 'if exited loop early, i will be < len 1
End Function