Search database for specific words many times

[Keithuk]

Hi guys.

I've searched in here but nothing useful shows.

I've made a few database apps over the years using DAO. I know its old but it works perfectly for the thousands of users that have my app. It has a search facility that will search any Field for specific characters and show every line of the database with the info.

This app is slightly different because it relies on the use type certain codes into a textbox (txtCode) seperated by a ;

'txtCode.Text = "B0N;CR8;G0K;H6L;J0N;D93;1AT;1G9;2FJ;1NL;5RV;5SJ;TG3;0BE;3U1;QG1;8AE;8GU;8ZH;1KD;1ZA;G07;7MG;0Y1;4UP ;4X3;4R4;4K3;N2T;5MD;8RM;2JQ;E0A;0AE;0BE;2UC;2G5;1JC;L58;0YB;"

Note: There is no space after 4UP ; thats just how it shows on here.

I've used the Split funtion to seperate each of the 3 characters. I added a temporary Listbox just to show each 3 characters and that show perfectly.

The problem is it finds the first 3 characters then stops. I used a For/Next loop to search for all 31 characters I have txtResults.Text to show the results as well as its easier to print of after as the code found on here for printing a ListView shows errors.

lvwCodes = ListView
Table = Codes with 3 Fields, Option Code, Group, Description

Private Sub FindWord()

Dim Pos As Long
Dim Sortby As String
Dim Result() As String
Dim B As Integer
Dim Word As String

On Error GoTo ErrHandler

Sortby = "SELECT [Option Code], Group, Description"
Sortby = Sortby & " FROM " & "[Codes]"
Sortby = Sortby & " ORDER BY [Option Code] ASC, Group ASC, Description ASC"

txtCode.Text = UCase(txtCode.Text)
Result = Split(Trim(txtCode.Text), ";")

'Shows each 3 character group in Result array
List1.Clear
For B = LBound(Result) To UBound(Result)
    List1.AddItem Result(B)
Next

Set Rs = DBname.OpenRecordset(Sortby)

lvwCodes.ListItems.Clear
txtResults.Text = "Option Code:" & "   Group: " & "  Description:" & vbCrLf & vbCrLf
For B = LBound(Result) To UBound(Result)

    Do While Not Rs.EOF
        Word = Rs.Fields("Option Code").Value
        Pos = 0
        Pos = InStr(1, Result(B), Word, vbTextCompare)

        'I tried this but its still the same
        'If Word = Result(B) Then

        If Pos > 0 Then
            Set itmX = lvwCodes.ListItems.Add(1, , CStr(Rs![Option Code]))
    
            If Not IsNull(CStr(Rs![Option Code])) Then
                'itmX.SubItems(1) = (Rs![Option Code])
                txtResults.Text = txtResults.Text & (Rs![Option Code])
            End If

            If Not IsNull(CStr(Rs!Group)) Then
                itmX.SubItems(1) = (Rs!Group)
                txtResults.Text = txtResults.Text & "            " & (Rs!Group) & "      "
            End If
                    
            If Not IsNull(CStr(Rs!Description)) Then
                itmX.SubItems(2) = (Rs!Description)
                txtResults.Text = txtResults.Text & (Rs!Description) & vbCrLf
            End If
        Else

            'This doesn't show missing characters
            If Pos = InStr(1, Result(B), Word, vbTextCompare) = 0 Then
                itmX.SubItems(1) = Result(B) & " Not found"
                txtResults.Text = txtResults.Text & Result(B) & " Not found" & vbCrLf
            End If
        End If
        
        Rs.MoveNext
    Loop
Next
Rs.Close
lvwCodes.Refresh

Exit Sub
ErrHandler:
MsgBox Err.Number & " " & Err.Description, 16, "frmDecode FindWord"
Open ErrorLog For Append As #1
Write #1, Err.Description & " " & Err.Number & " frmDecode FindWord"
Close #1
Resume Next


End Sub

Any thoughts on how to search for each group of 3 characters and to show if no code it found in the ListView and textbox not a messagebox?