Faster search for RTB

[GARY MICHAEL]

Hello, Anybody know of a faster way to search a rich text box that contains the whole Bible? This code takes forever. If I take just the old testiment by its self or just the new, it is fast enough, but the whole Bible is too slow. HELP!


VB Code:

Private Sub Command1_Click()
Dim LOOPNUM As Integer
Dim strtext As String
Dim intIdx As Long
Dim RESPONSE As String
Dim CountLeft As Integer

strtext = rtfText7.Text
If txtFind2.Text = "" Then
COUNTED = 0
Exit Sub
End If

COUNTED = COUNTED + 1
On Error GoTo FIXIT

CountLeft = WordCount(strtext, txtFind2.Text) - COUNTED

LOOPNUM = LOOPNUM + 1
FoundLabel.Caption = " " & "Hit #" & COUNTED & " of " & WordCount(strtext, txtFind2.Text) & ", there are " & CountLeft & " Left"

If LOOPNUM = 2 Then
FoundLabel.Caption = " " & "Hit #" & COUNTED - 1 & " of " & WordCount(strtext, txtFind2.Text)

COUNTED = 0
Exit Sub
End If

POS = WholeBible.rtfText7.SelStart
POS = InStr(POS + 1, WholeBible.rtfText7.Text, txtFind2.Text)

If POS = 0 Then

RESPONSE = MsgBox("your search for ~ " & txtFind2 & " ~ ... was found a total of " & COUNTED - 1 & " time(s). ... Do you want to start from the beginning?", vbYesNo)
COUNTED = 0
FoundLabel.Caption = " " & "Hit #" & COUNTED & " of " & WordCount(strtext, txtFind2.Text)

If RESPONSE = vbNo Then
Exit Sub
End If
Else

rtfText7.Find txtFind2, rtfText7.SelStart + 1, Len(rtfText7.TextRTF), rtfWholeWord

rtfText7.SelColor = vbRed
rtfText7.SetFocus

End If

WholeBible.rtfText7.SelStart = POS 'GOES TO THE TOP
Exit Sub


FIXIT:
MsgBox "Try a less common word in your search."
Exit Sub

End Sub

[bushmobile]

I can't figure out what you're trying to do with your code, have you accidently pasted two subs together?

I should think the fastest way to search an RTB would be to use the built in Find method as it will be written in a low-level language and optimised:

Private Sub Command1_Click()
    Debug.Print CountWords(RichTextBox1, "hello")
End Sub
 
Private Function CountWords(ByRef rtb As RichTextBox, ByRef sFind As String) As Long
    Dim lPos As Long
    Do
        lPos = rtb.Find(sFind, lPos, Len(rtb.Text), rtfWholeWord)
        If lPos >= 0 Then CountWords = CountWords + 1: lPos = lPos + Len(sFind)
    Loop Until lPos = -1
End Function