Search Form

[ptech]

I've inherited a database that has a search form. Basically the user can type in a file number or a streetname or an owner name and it searches these 3 fields simultaneously for any matches. As the program finds matches it puts the matching records in a text box below the search field. The user can then double-click the record they want and it opens another form which contains all the info. The search works but it is incredibly SLOW even when there are a small number of records in the table (< 100). Any help would be appreciated !!

Option Compare Database
Option Explicit

Private Sub Form_Open(Cancel As Integer)
    Me.lstFound.RowSource = ""
End Sub
Private Sub lstFound_DblClick(Cancel As Integer)
    Dim strAM_FileCode As String

    strAM_FileCode = Trim(Mid(Me.lstFound.Value, 13, FindFirst(Me.lstFound.Value, " ")))
    DoCmd.OpenForm "Add_View_OPA", acNormal
    Forms!Add_View_OPA.Recordset.FindFirst "AM_File = '" & strAM_FileCode & "'"
End Sub
Private Sub txtSearch_Change()

    Me.lstFound.RowSource = ""

    If Len(Me.txtSearch.Text) > 5 Then

        Dim con As ADODB.Connection
        Set con = CurrentProject.Connection
        Dim rs As New ADODB.Recordset
        rs.ActiveConnection = con
        Dim newListItem As String
        'Create SQL Selection
        Dim sql As String
        ' -- Search the Area Municipal FileCode

        sql = "SELECT TOP 100 Amendments.AM_File, Amendments.Owner, Amendments.Address_StName, Amendments.Full_Address , Amendments.Date_Received " & _
              "FROM Amendments " & _
              "WHERE Amendments.AM_File Like '%" & Me.txtSearch.Text & "%'" & _
              "ORDER BY Amendments.Date_Received"

        rs.Open sql

        While rs.BOF <> True And rs.EOF <> True
            'newListItem = Replace(Replace(CStr(rs.Fields("ThirtyT").Value) & " " & CStr(rs.Fields("Mun").Value) & " " & CStr(rs.Fields("Location").Value) & " " & CStr(rs.Fields("Owner").Value), ",", " "), Me.txtSearch.Text, UCase(Me.txtSearch.Text))

            newListItem = "AM_File# -- " & Nz(rs.Fields("AM_File").Value, " ") & " " & " Owner -- " & Nz(rs.Fields("Owner").Value, " ") & " " & " Address -- " & Nz(rs.Fields("Full_Address").Value, " ")
            newListItem = Replace(newListItem, ",", " ")
            newListItem = Replace(newListItem, Me.txtSearch.Text, UCase(Me.txtSearch.Text))

            NoDuplicatesInList Me.lstFound, newListItem
            rs.MoveNext
        Wend

        rs.Close

        ' -- Search the St_Name field
        sql = "SELECT TOP 100 Amendments.AM_File, Amendments.Owner, Amendments.Address_StName, Amendments.Full_Address, Amendments.Date_Received " & _
              "FROM Amendments " & _
              "WHERE Amendments.Address_StName Like '%" & Me.txtSearch.Text & "%'" & _
              "ORDER BY Amendments.Date_Received"

        rs.Open sql

        While rs.BOF <> True And rs.EOF <> True

            newListItem = "AM_File# -- " & Nz(rs.Fields("AM_File").Value, " ") & " " & " " & " Owner -- " & Nz(rs.Fields("Owner").Value, " ") & " " & " Address -- " & Nz(rs.Fields("Full_Address").Value, " ")
            newListItem = Replace(newListItem, ",", " ")
            newListItem = Replace(newListItem, Me.txtSearch.Text, UCase(Me.txtSearch.Text))

            NoDuplicatesInList Me.lstFound, newListItem
            rs.MoveNext
        Wend

        rs.Close
        ' -- Search the Owner field

        sql = "SELECT TOP 100 Amendments.AM_File, Amendments.Owner, Amendments.Address_StName, Amendments.Full_Address, Amendments.Date_Received " & _
              "FROM Amendments " & _
              "WHERE Amendments.Owner Like '%" & Me.txtSearch.Text & "%' " & _
              "ORDER BY Amendments.Date_Received"

        rs.Open sql

        While rs.BOF <> True And rs.EOF <> True

            newListItem = "AM_File# -- " & Nz(rs.Fields("AM_File").Value, " ") & " " & " " & " Owner -- " & Nz(rs.Fields("Owner").Value, " ") & " " & " Address -- " & Nz(rs.Fields("Full_Address").Value, " ")
            newListItem = Replace(newListItem, ",", " ")
            newListItem = Replace(newListItem, Me.txtSearch.Text, UCase(Me.txtSearch.Text))

            NoDuplicatesInList Me.lstFound, newListItem
            rs.MoveNext
        Wend

        rs.Close

        'Close off Recordset
        Set rs = Nothing
        Set con = Nothing

    End If

End Sub
Private Sub NoDuplicatesInList(lst As ListBox, str As String)

    Dim tf As Boolean
    Dim x As Integer
    If lst.ListCount = 0 And str <> "" Then
        lst.AddItem str
        'check to make sure no duplicate entries get into list box
    Else
        tf = False
        For x = 0 To lst.ListCount - 1
            If lst.ItemData(x) <> str Then
                tf = False
            Else
                tf = True
                Exit For
            End If
        Next x
        If tf = False And str <> "" Then
            lst.AddItem str
        End If
    End If
End Sub
Private Function FindFirst(str As String, chr As String) As Integer
    Dim i As Integer
    i = 1

    Do While i < Len(str)
        If Mid(str, i, 1) = chr Then
            FindFirst = i
            Exit Do
        End If
        i = i + 1
    Loop
End Function

 

[MarkK]

OMG!
Here's some code to create ONE where clause. Use this to create ONE recordset and just show everything in the recordset

[COLOR="Green"]'global form variables[/COLOR]

private m_fields as variant
private property Get vFields as Variant
[COLOR="Green"]  'exposes an array of field names to use as a control structure
  'creates the structure once, on first reference, and maintains it
  'for the life of the form
[/COLOR]  if isempty(m_fields) then
    m_fields = Split("AM_File Owner Address_StName Full_Address Date_Received")
  end if
  vFields = m_fields
end property

function GetWhereClause(searchText as string) as string
[COLOR="Green"]   'returns a SQL WHERE clause for every character the user types.  
   'receives the Textbox.Text provided by the Textbox_Change() event.
   'consumes the field list, created above, as a control structure to create
   'a where clause comparing the user's input to multiple fields in the table
[/COLOR]   Dim i As Integer
   Dim prm As String
   dim tmp as string
   prm = "'*" & Replace(searchText, "'", "_") & "*'"
   For i = 0 To UBound(vFields)
      tmp = tmp & "OR [" & vFields(i) & "] LIKE " & prm & " "
   Next i
[COLOR="Green"]   'drop the leading 'OR' if it exists[/COLOR]
   if tmp <> "" then tmp = Mid(tmp, 3)
   GetWhereClause = tmp
End Function

Now create ONE recordset on the textSearch_Change() event and I wouldn't worry about duplicates. If duplicates are a problem then open the recordset on a query that does a GROUP BY or DISTINCTROW beforehand.
Post back if you need more specifics,
Cheers,

 

[ptech]

Thanks Lagbolt,
I've yet to implement your recommendation as I've been pulled away on other projects and it's time for some holidays.