Search for a record in a database

Q: I want to have a lookup list box, which I fill with data from one field in a table. If the user selects one of the records, other field data from the same record shall be made available

A. The following should be a solution. Let a double-click in the list box (List1) automatically find the corresponding record in the table and present data from other fields for that record - in the example in three text boxes (txtAdress, txtStad, and txtLand) on the form.

Insert the following code

Option Explicit

'A reference to the Microsoft DAO 3.6 (or 3.51) Object library is required

Dim Db As Database
Dim Rs As Recordset

Private Sub Form_Load()
  Dim sSQL As String
  'Connect to the Northwind database
  Set Db = DBEngine.Workspaces(0).OpenDatabase("C:\...\Northwind.mdb")

  'Retrieve all customer names
  sSQL = "SELECT CompanyName FROM Customers"
  Set Rs = Db.OpenRecordset(sSQL)

  'Loop through the recordset
  With Rs
    Do Until .EOF
      'Add each record to the list box
      List1.AddItem !CompanyName
  End With
  Set Rs = Nothing
End Sub


Private Sub Form_Unload(Cancel As Integer)
  'Close the database
  Set Db = Nothing
End Sub

Private Sub List1_DblClick()
  Dim sSQL As String

  'Create a SQL query looking for data for the record with the name selected in the list box

  sSQL = "SELECT Address, City, PostalCode, Country FROM Customers WHERE CompanyName = '" _
    & List1.Text & "'"

  'Since the apostrophe ' is used as string start and string end in SQL queries,
  'company names containing an apostrophe will create problems
  'By exhanging the sSQL expression above for the one below, which
  'calls a special function, this problem is solved.

  'sSQL = "SELECT Address, City, PostalCode, Country FROM Customers WHERE CompanyName = '" & _
    SearchString(List1.Text) & "'"

  'Open a recordset on this query and fill the other text boxes
  'If there are two companies with the same name, we will only see the first one.
  Set Rs = Db.OpenRecordset(sSQL)
  With Rs
    txtAdress = !Address
    txtStad = !City
    txtLand = !PostalCode & " " & !Country
  End With
  Set Rs = Nothing
End Sub


Private Function SearchString(Namn As String) As String
  'This function loops through each character in the Namn string.
  'Each apostrophe will be duplicated
  Dim Position As Integer, Tecken As String
  'Loop through the string
  For Position = 1 To Len(Namn)
    'Find the character
    Tecken = Mid$(Namn, Position, 1)
    'If it is a ', add one ' to the string
    If Tecken = "'" Then
      SearchString = SearchString & "'"
    End If
    'Then add the character itself, whichever it is.
    SearchString = SearchString & Tecken
  Next Position
End Function