Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Search Database based on criteria from a listbox

Status
Not open for further replies.

EDGE99

Technical User
Oct 9, 2006
58
US
I am having trouble coming up with a good search to find simular customer names within my database. A friend of mine suggested the code in red but it is really not doing what I need it to.

I could have customer names that vary so I need it to match names like the example below.

Lets say I have these names in my master table

Advanced Communication Systems Inc
Advnaced Communication sys
Advanced Communications

I have a new name which is Advanced Comm the code below would not find any of the above names unless I put the % very high. The downside of moving the % higher is the number of names that are not even close to Advanced Communications will be listed

Does anyone have a better way to do comparisons to find like names?

Code:
...
...
Set ctl = frm!lstNewPaNames
...
...

For Each varItm In ctl.ItemsSelected
    For intI = 0 To ctl.ColumnCount - 1
      'find names with the best matches
      Do While Not rsMaster.EOF
         If IsNull(rsMaster![paCustName]) Then
            Exit Do
         End If
      [COLOR=red]
      intMatches = LD(rsMaster![paCustName], ctl.Column 
      (intI, varItm))
                
      'At this point intMatches = the number of changes
      required to make this string match the other strings
   
      MatchPercent = (intMatches / Len(ctl.Column
      (intI, varItm))) * 100

      'If we matched more than a certain percent of the
      characters then add it to the matched table

      If MatchPercent < 40 Then
      [/color]
       With rsMatch
          .AddNew
          .Fields("matchAxisID") = rsMaster![paAxisID]
          .Fields("matchDataCentID") = rsMaster![paDataAccessID]
          .Fields("matchPaName") = rsMaster![paCustName]
          .Fields("matchPaDesignation") = rsMaster![paDesignation]
          .Fields("matchDiscount") = rsMaster![pa05Discount]
                                                       
          .Update
       End With
     End If
                
     rsMaster.MoveNext
     Loop
            
      'Refresh the form so the list box gets it's new data
            Me.Refresh
    Next intI
  Next varItm
 
This seems like something that requires a nice user interface to validate because there are no rules that could be written. My idea would be a multi select find as you type list box, kind of like in Outlook when you use the address book. But as I find a match I move it to a second list box and remove it from the search capability.

The user types the letter "A" and the list filters down to everything that starts with "A". If he sees ones he wants he selects them and they are removed from the search list and pushed to the found listbox. Then the user types in "D" and the list narrows down to everything that starts with "AD" and he can select the things he sees. So he can choose "Advanced Communications" but disregard "Advanced Commercial Products". He can also select "Adv Comm" because he knows from experience that means Advanced Communications not Advanced Commercial Products. As he keeps typing the list narrow and narrows.

I have a couple of Class modules that do a lot of this, but would need to be combined.

If you need to do this completely automated and be accurate, I would think you would need some very complex huristics, depending on your rules for naming conventions. For example there is no rule that would ever decipher that "Adv Comm" was Advanced Communications not Advanced Commercial.
 
I played with this idea and used a very large list of names to see if the interface worked well. Not sure if this will meet your needs, but I can think of a few places I will use this interface. This is also a simple way to move values back and force between two listboxes without using a value list. You can quickly narrow down and scan a very large list of names, and try different permutations.

1) build the form with 2 listboxes and a textbox.
txtBxFilter
lstSelectFrom
lstSelectedNames

2) Create a table "tblSelected" that has one field in it. The ID of a selected record. This table is cleared out to start and then you add and delete from it as you select and deselect a record.

3) lstSelectFrom starts off with all the names listed. If you click on the lstSelectFrom the selected ID is added to the table. It is then removed from lstSelectFrom by rebuilding the query and it appears in lstSelectedNames

3) lstSelectedNames is based on a query that joins tblSelected to the table of names. As you add an ID to tblSelected it appears in the list

4) txtBx filter allows you to filter lstSelectFrom. As you type "AD" only things starting with AD and not already in tblSelected appear. If you backspace to "A", everything starting with "A" appears

the code is rather short the trick is in the query to check that records in lstSelectFrom are not in tblSelected and that they begin with the text typed in txtBxFilter.

Code:
Public rsSelected As DAO.Recordset

Private Sub Form_Open(Cancel As Integer)
  'Clear out tblSelected on opening
  Dim strSql As String
  DoCmd.SetWarnings (False)
  strSql = "Delete * from tblSelected"
  DoCmd.RunSQL strSql
  DoCmd.SetWarnings (True)
  Set rsSelected = CurrentDb.OpenRecordset("tblSelected", dbOpenDynaset)
End Sub

Private Sub lstSelectedNames_AfterUpdate()
  'If you click on a selected name it removes it from the selected list
  rsSelected.FindFirst ("fkIntPersonID = " & lstSelectedNames)
  rsSelected.Delete
  lstSelectFrom.RowSource = getNewQuery
  lstSelectedNames.Requery

End Sub

Private Sub lstSelectFrom_AfterUpdate()
  'if you select a name it adds the ID to tblSelected
  rsSelected.AddNew
  rsSelected.Fields("fkIntPersonID") = lstSelectFrom.Value
  rsSelected.Update
  lstSelectFrom.RowSource = getNewQuery
  lstSelectedNames.Requery
End Sub
Public Function getNewQuery() As String
  'The query checks what is in the tblSelected and what is in txtBxFilter
  Dim strSql As String
  txtBxFilter.SetFocus
  txtBxFilter.SelStart = Len(txtBxFilter.Text)
  strSql = "SELECT ID, strLastName FROM tblNames "
  strSql = strSql & " WHERE ID Not In (select fkIntPersonID from tblSelected) AND "
  strSql = strSql & "(tblNames.strLastName) Like '" & txtBxFilter.Text & "*'"
  strSql = strSql & " ORDER BY strLastName"
  getNewQuery = strSql
End Function
Private Sub txtBxFilter_Change()
  'When you type in the text box it filters the list to only those names
  'starting with the letters in the box
  lstSelectFrom.RowSource = getNewQuery
End Sub
 
Another thing that might help you would be the use of regular expressions. This thread: thread701-1347547 should help you out.

You could do something like split your company name into separate words, and have a where condition in a query like this:

Code:
WHERE RegXChk(name, left(Word1, 3)) = True
And (Word2 = "" or RegXChk(name, left(Word1, 3)) =True)
And (Word3 = "" or RegXChk(name, left(Word2, 3)) = True)

There is some overhead involved in using regular expressions, but they are great for doing matching like this (and probably better than character by character comparison).

Hope this helps,

Alex





Ignorance of certain subjects is a great part of wisdom
 
MajP, Alex,

Thanks for the posts. I will look into both of your suggestions and see which one will fit best. I would like to thank both of you for your input.

Thanks,
Scott
 
Using Alex's general idea and the reference to his thread, I would envision a form that provides the user several fast means to search for possible matches using different rules.

I would still have my two listboxes, but now I would add some more options.
1) Add another text box and choices and a cmd button. So if I type "Adv" everything with "Adv" appears in my list. If I type "Advanced Comm" everything with "Advanced Comm". Then I again select the ones I want

Code:
Private Sub cmdSearchForWord_Click()
  Dim strSearch As String
  Dim strSql As String
  strSearch = Me.txtBxFullWord.Value
  strSql = "SELECT ID, strLastName FROM tblNames "
  strSql = strSql & " WHERE ID Not In (select fkIntPersonID from tblSelected) AND "
  strSql = strSql & "(tblNames.strLastName) Like '*" & strSearch & "*'"
  strSql = strSql & " ORDER BY strLastName"
  lstSelectFrom.RowSource = strSql
End Sub

All of this requires user input, but this gives the user
1. several means and rules for searching.
2. quick way to select and remove from the list possible choices

I demoed this with a list of 1000 names and 10 versions of Advance Communications. I could find and select all versions in seconds.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top