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?

[si_the_geek]

There is no need for the If Pos ... = 0 Then line (because it is the same as the Else on the previous line), so you should remove it.

If you look carefully at that line, there is a big mistake (two = signs).


Note that you should probably remove the CStr from IsNull(CStr( , as I expect the CStr will convert Null to an empty string.

[DataMiser]

Actually CSTR(Null) will produce a runtime error "Invalid Use of NULL"

NULL can not be used with any string function as far as I know unless of course you append a "" to it

Debug.Print CStr(Null)

Will produce an error

Debug.Print CStr(Null & "")

Will not produce an error

[Keithuk]

Thanks for the replies.

I just use Pos = 0 to reset it just in case.

I use If Not IsNull(CStr(Rs![Option Code])) Thats checking for Not Null just to check there is nothing empty in the Field. That code works perfectly on my normal search part and it will show multiple lines in the ListView.

In my other apps I put - just to give it a String. When I put extra error traps in that did show an error because I had a blank Field which I corrected.

Any thoughts on how to show if any of 3 characters are not in the database in the ListView and textbox not a messagebox?

I've uploaded my app but this only has 48 records which show what was fitted to my vehicle with a few extra's in the database my other one has 6800 which will end up at 11,000 plus when I've finished. The database is in a Resource file and it extracts it on startup and deletes it when finished (OC.mbd) it saves uses messing up any code.

[si_the_geek]

I just use Pos = 0 to reset it just in case.

That is not what I was referring to, this is the line that should never have existed (because it is repeating the previous line), and has a mistake in it:

            If Pos = InStr(1, Result(B), Word, vbTextCompare) = 0 Then

I use If Not IsNull(CStr(Rs![Option Code])) Thats checking for Not Null just to check there is nothing empty in the Field. That code works perfectly on my normal search part and it will show multiple lines in the ListView.

It doesn't matter why you are using it, you never should.

If you want to check for Null, remove the CStr, as that doesn't help you at all... at best it does nothing, in other cases it creates unnecessary errors.

If you want to check for Null and/or an empty string, use: If (Rs![Option Code] & "") <> "" Then '(or ="" if apt)

[SamOscarBrown]

Besides all that, your real issue is that you remain at the end of the recordset after the first time through...you have to reset it to the first item:

After this line,

For B = LBound(Result) To UBound(Result)

insert this one:

    Rs.MoveFirst

[SamOscarBrown]

Hence, your final code for the command button, cmdCode, and the FindWord Sub, could look like this:

Private Sub cmdDecode_Click()

Dim Temp As String
Dim TempWord As String
Dim Word As String
Dim Result() As String
Dim Result2() As String
Dim B As Integer
Dim N As Integer
Dim Pos As Integer
Dim strMatch As String

On Error GoTo ErrHandler

If Trim(txtCode.Text) = "" Then
    MsgBox "You must enter some code from your Options Sticker?", 16, "Enter some code?"
    txtCode.SetFocus
    Exit Sub
End If

FindWord  'REMOVED the Call proword--old practice)

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

End Sub

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
'Table Codes with 3 Fields, Option Code, Group, Description
Sortby = "SELECT [Option Code], Group, Description"
Sortby = Sortby & " FROM " & "[Codes]"
Sortby = Sortby & " ORDER BY [Option Code] ASC, Group ASC, Description ASC"

If Right(Trim(txtCode.Text), 1) <> ";" Then
    txtCode.Text = txtCode.Text & ";"
End If
txtCode.Text = UCase(txtCode.Text)
Result = Split(Trim(txtCode.Text), ";")
'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;"
'Option Code: - Group:  - Description:
'0A1 - TUE - 2 doors
Set Rs = DBname.OpenRecordset(Sortby)
V = 0
lvwCodes.ListItems.Clear
txtResults.Text = "Option Code:" & "   Group: " & "  Description:" & vbCrLf & vbCrLf
For B = LBound(Result) To UBound(Result)
    Rs.MoveFirst
    Do While Not Rs.EOF
        Word = Rs.Fields("Option Code").Value
        Pos = InStr(1, Result(B), Word, vbTextCompare)
        If Pos > 0 Then
            Set itmX = lvwCodes.ListItems.Add(1, , CStr(Rs![Option Code]))
            If Not IsNull(CStr(Rs![Option Code])) Then
                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
            V = V + 1
        End If
        Rs.MoveNext
    Loop
Next B
Rs.Close
lvwCodes.Refresh
StatusBar1.Panels.Item(2) = V & " Option Code(s). "
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
End Sub

[Keithuk]

Thanks SamOscarBrown that was the problem Rs.MoveFirst I forgot you have to start a new search from the beginning as I've only needed to search the database once.

As I said "Any thoughts on how to search for each group of 3 characters and to show if NO code it found in the Database in the ListView and textbox not a messagebox?"

[SamOscarBrown]

Yes, but I will have to look at that tomorrow morning....but, see if you can figure it out based upon this:

re-include an Else Clause in your current IF statement.
Obviously, your IF returned a value on some of the lines, so IF nothing IS returned, you have the value of "Word" already (although I would have used a more descriptive variable), so if you don't get a match, you can update your listview (say a new column) with the words, "Not Found". But, that doesn't make much sense. Instead, I'd think you might put that stuff (as you are sure to get a lot more than one non-match) in a listbox. Either way, you already have the code....no need to check for NULL, zero-length, as you already know in your IF statement if you found the 'Word' or not. If NOT, put the 'Word' in the listbox, which could be titled, "3-Letter Combinations Not Found".

[DataMiser]

I am having a bit of trouble following the code there but am very curious why you are not using a where clause to find the matching records rather than looping through all the records in the db?

I use If Not IsNull(CStr(Rs![Option Code])) Thats checking for Not Null just to check there is nothing empty in the Field. That code works perfectly on my normal search part and it will show multiple lines in the ListView.

Actually no it will not work perfectly

If the RS!OptionCode is NULL then it will give you an invalid use of null error due to the use of CSTR() which will not accept a NULL value
The test for ISNull will do nothing as it is not possible for CStr(Rs![Option Code]) to ever return a null either it will be a string or it will be a run time error but never null

So it is not working perfectly. Apparently it is not throwing an error and you seem to get the results you want but that does not mean it should not be changed.

That's kinda like writing

If ProgramDoesntCrash on CSTR(RS!OptionCode) then we are good to go

[DataMiser]

Hence, your final code for the command button, cmdCode, and the FindWord Sub, could look like this:

            If Not IsNull(CStr(Rs![Option Code])) Then
                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

The only reason to use ISNull is if there is a possibility that the field will contain a Null value

In no case should it ever be used as it is here. It will never be true and if there is a NULL then the program will crash on the CSTR() call not only that but if the intent is to weed out blank records in a text field then neither function should be used and it should instead test for =VBNullString or it should test for =""

[SamOscarBrown]

I am having a bit of trouble following the code there but am very curious why you are not using a where clause to find the matching records rather than looping through all the records in

probably because Op also wanted (for whatever reason) to also show a 'negative' return for all the unfound records.

[Keithuk]

probably because Op also wanted (for whatever reason) to also show a 'negative' return for all the unfound records.

Correct Sam I need to know if a code that entered in txtCode isn't in the database records.

The reason being a user can type in 30 or 40 codes they can even type the wrong code in so without checking that every code is shown it quicker to show XXX Not Found in the ListView and txtResults.

[Keithuk]

I've added all 12,324 items to the database and thanks to Sam it searches and shows all codes typed in.

I still can't figure out how to show if a code isn't in the database in the ListView and textbox, any thoughts?

The code I found on here to print the ListView doesn't work it bring up a Method or Data member not found error in Bold.

For I = 1 To lvwCodes.ListItems.Count
Printer.Print lvwCodes.ListItems(I); Tab(10); lvwCodes.ListItems(I).ListSubItems(1); Tab(10); lvwCodes.ListItems(I).ListSubItems(2)
Next