instr Count

[Merri]

Here you have something that can take a very big string and still be fast (the ones by you and penagate keep getting slower and slower with bigger strings much more easily):

Option Explicit

Private Declare Sub RtlMoveMemory Lib "ntdll.dll" (ByRef lpvDest As Any, ByRef lpvSrc As Any, ByVal cbLen As Long)
'Private Declare Function VarPtrArray Lib "msvbvm50.dll" Alias "VarPtr" (Var() As Any) As Long
Private Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (Var() As Any) As Long

Private BufStrHeader(5) As Long
Private BufFindHeader(5) As Long
Private BufStr() As Integer
Private BufFind() As Integer
Private OldStr As Long
Private OldFind As Long
Public Sub SisicInitialize()
    BufStrHeader(0) = 1
    BufStrHeader(1) = 2
    BufStrHeader(4) = &H7FFFFFFF
    BufFindHeader(0) = 1
    BufFindHeader(1) = 2
    BufFindHeader(4) = &H7FFFFFFF
    OldStr = 0
    OldFind = 0
End Sub
Public Sub SisicTerminate()
    RtlMoveMemory ByVal VarPtrArray(BufStr), 0&, 4
    RtlMoveMemory ByVal VarPtrArray(BufFind), 0&, 4
End Sub
Public Function SisicM(pStr As Long, pFind As Long, lenStr As Long, lenFind As Long) As Long
    Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim l As Long
    Dim Flag As Long
    
    If OldStr <> pStr Then
        BufStrHeader(3) = pStr
        RtlMoveMemory ByVal VarPtrArray(BufStr), VarPtr(BufStrHeader(0)), 4
        OldStr = pStr
    End If
    If OldFind <> pFind Then
        BufFindHeader(3) = pFind
        RtlMoveMemory ByVal VarPtrArray(BufFind), VarPtr(BufFindHeader(0)), 4
        OldFind = pFind
    End If
    
    If lenFind = 1 Then
        j = BufFind(0)
        For i = lenStr - 1 To 0 Step -1
            k = BufStr(i)
            If k = j Then SisicM = SisicM + 1
        Next i
    Else
        lenFind = lenFind - 1
        For i = lenStr - 1 To lenFind Step -1
            For j = lenFind To 0 Step -1
                k = BufFind(j)
                l = BufStr(i - (lenFind - j))
                If Not (k = l) Then Flag = 1: Exit For
            Next j
            If Flag = 0 Then SisicM = SisicM + 1 Else Flag = 0
        Next i
    End If
End Function

Usage:

SisicInitialize
Do
    SisicM StrPtr(SEARCHSTRING), StrPtr(KEYWORD), Len(SEARCHSTRING), Len(KEYWORD)
Loop
SisicTerminate

I haven't even done my main optimizations yet