Count how many words contain any of specific letters

Question

I'm trying to compute the total number of words that contain any of the letters "j", "a", "d", "e".

If the word for example, was "Jacket" then it would be counted. The entire macro goes through a list of words in column A and rows 3 to 373659.

Dim count As Long
Dim word As String
Dim row As Long
    
count = 0
    
For row = 3 To 373659
    word = Cells(row, 1).Value
    If InStr(word, "j") Or InStr(word, "a") Or InStr(word, "d") Or     InStr(word, "e") Then
        count = count + 1
    End If
Next row

Is this code correct? Can it be improved?

Answer 1

This should be more efficient:

Sub Tester()
    
    Dim count As Long
    Dim word As String
    Dim row As Long, arr, e, data
        
    count = 0
    arr = Array("a", "e", "d", "j") 'ordering most-common to least-common
                                    '  will give you a slight boost
    
    data = Range("A3:A373659").Value 'read the whole range,
                                     '  not cell-by-cell
    
    For row = 1 To UBound(data, 1)
        word = lcase(data(row, 1))

        'either test letter-by-letter...
        For Each e In arr
            If InStr(word, e) > 0 Then 
                count = count + 1
                Exit For  'exit after first match: no need to test others
            End If
        Next e

        'or use `Like`
        If word Like "*[aedj]*" Then
            count = count + 1
        End If

    Next row

End Sub