Here is an example that works from one of my databases. It uses 4 items in the first combo box (cboSeach); LAST NAME, PPNO, DOB, and REMOVE FILTER. It uses the constants to set the RecordSource on cboSearchSelector (the second combo box). The AfterUpdate event on the second combo box then handles the results of the selection automatically.
Cheers! Don't spend too many nights until 11:30 PM.
Private Sub cboSearch_AfterUpdate()
Dim strCriteria As String
Const SPPNO As String = "SELECT tblPerson.PPNO, tblPerson.LAST, " _
& "tblPerson.FIRST FROM tblPerson;"
Const SLAST As String = "SELECT DISTINCT tblPerson.LAST " _
& "FROM tblPerson;"
Const SDOB As String = "SELECT DISTINCT tblPerson.DOB " _
& "FROM tblPerson;"
On Error Resume Next
With Me.cboSearchSelector
Select Case cboSearch.Column(0)
Case "LAST NAME"
.RowSource = SLAST
.ColumnWidth = 1.5
.ListWidth = 1.5
.ColumnCount = 1
Me.cboSearchSelector = Null
Me.lblSearchSelector.Caption = "Search for Last Name..."
.Requery
Case "PPNO"
.RowSource = SPPNO
.ColumnWidth = 0.5 & "," & 1 & "," & 1
.ListWidth = 2.5
.ColumnCount = 3
Me.cboSearchSelector = Null
Me.lblSearchSelector.Caption = "Search for PPNO..."
.Requery
Case "DOB"
.RowSource = SDOB
.ColumnWidth = 1.5
.ListWidth = 1.5
.ColumnCount = 1
Me.cboSearchSelector = Null
Me.lblSearchSelector.Caption = "Search for DOB..."
.Requery
Case "REMOVE FILTER"
Me.lblSearchSelector.Caption = "Select a Search..."
Me.cboSearchSelector = Null
Me.RecordSource = "SELECT tblPerson.PPNO, tblPerson.LAST, tblPerson.FIRST, " _
& "tblPerson.OI, tblPerson.RACE, tblPerson.SEX, tblPerson.ADDRESS, " _
& "tblPerson.CITY, tblPerson.ZIP, tblPerson.DOB, tblPerson.PHONE1, " _
& "tblPerson.PHONE2, tblPerson.REVISED, tblPerson.INACTIVE, tblPerson.SKINTYPE, " _
& "tblPerson.SHAMWK, tblPerson.FITZ_SUN, tblPerson.TIMES, tblPerson.WHERE, " _
& "tblPerson.STIMES, tblPerson.BTIMES, tblPerson.COMMENTS, tblPerson.HU_ONLY, " _
& "tblPerson.ARMLOT, tblPerson.SMOKE, tblPerson.HRT, tblPerson.BY_HAND, " _
& "tblPerson.TATTOOS, tblPerson.SKIN_ALLER, tblPerson.DRUG_ALLER, " _
& "tblPerson.PSOR_ECZEM, tblPerson.SKIN_CANC, tblPerson.DIABETIC, " _
& "tblPerson.IMM_ANTI_, tblPerson.SHOWER, tblPerson.BATHE, tblPerson.ATOPIC, " _
& "tblPerson.ADW, tblPerson.DANDSMP FROM tblPerson;"
'Me.FilterOn = False
Me.Requery
End Select
End With
End Sub
Private Sub cboSearchSelector_AfterUpdate()
Dim strCriteria As String
Dim strResult As String
On Error GoTo Exit_Proc
Select Case lstSearchSelector.Column(0)
Case "LAST NAME"
strCriteria = "LAST='" & cboSearchSelector & "'"
strResult = DLookup("[PPNO]", "tblPerson", strCriteria)
If Len(strResult) > 0 Then
strCriteria = "SELECT tblPerson.* FROM tblPerson WHERE " & strCriteria & ";"
Me.RecordSource = strCriteria
Me.Requery
Me.lblSearchSelector.Caption = "Search Successful ..."
Else
Beep
Me.lblSearchSelector.Caption = "Search Failed ..."
End If
Case "PPNO"
strCriteria = "PPNO=" & cboSearchSelector
strResult = DLookup("[PPNO]", "tblPerson", strCriteria)
If Len(strResult) > 0 Then
Me.RecordSource = strCriteria
Me.Requery
Me.lblSearchSelector.Caption = "Search Successful ..."
Else
Beep
Me.lblSearchSelector.Caption = "Search Failed ..."
End If
Case "DOB"
strCriteria = "DOB=#" & cboSearchSelector & "#"
strResult = DLookup("[PPNO]", "tblPerson", strCriteria)
If Len(strResult) > 0 Then
strCriteria = "SELECT tblPerson.* FROM tblPerson WHERE " & strCriteria & ";"
Me.RecordSource = strCriteria
Me.Requery
Me.lblSearchSelector.Caption = "Search Successful ..."
Else
Beep
Me.lblSearchSelector.Caption = "Search Failed ..."
End If
End Select
' Error handling block added by Error Handler Add-In. DO NOT EDIT this block of code.
' Automatic error handler last updated at 01-21-2003 10:25:25 'ErrorHandler:$$D=01-21-2003 'ErrorHandler:$$T=10:25:25
Exit_Proc:
Exit Sub
HandleErr:
Select Case Err.Number
Case 2001
GoTo Exit_Proc
Case Else
'Call HandleTheError("", "Form_frmPerson.cboSearchSelector_AfterUpdate", Err) 'ErrorHandler:$$N=Form_frmPerson.cboSearchSelector_AfterUpdate
End Select
Resume Exit_Proc
Resume
' End Error handling block.
End Sub -------------------------------------
scking@arinc.com
Try to resolve problems independently
Then seek help among peers or experts
But TEST recommended solutions
-------------------------------------