filter a subform based on multiple multi select list boxes

[woodey2002]

Hi Everyone and many thanks for your time.. I am trying to begin access and a bit of VBA i am enjoying it but I have a annoying problem I just can’t get any where on.
My databse mostly includes bits of code for different examples. I have one last thing to finish.
I am trying to create a search form that will allow users to select criteria from multiple sources eg ,multi select list boxes , combo boxes.

I have a subform showing all the required fields under the reports Tab of my main form. It’s unfiltered to begin and shows all records, when the user searches the form via the unbound controls listed above I have one error that I can’t figure out. It’s regarding my multi select list boxes.

I have 3 multi select list boxes that allow the user to search for counties, nationality’s or qualifications and then filter the subform to show results via my “Build filter” function .

County and nationality searches work fine with but when the user searches for qualification the form filters and shows the results which is great but right away but they are asked for the parameter for tblMemberqualifications.qualCode. even though its just filtered the suborm with the selected criteria.
If i enter the value for “qualcode” lets say 417 the form will work as desired. If i don’t enter the value i get the error message Run time error 2467 “ the expression you entered refers to an object that is closed our doesn’t exist”.

I think it maybe to do with the filtering on the main form “Me.RecordsetClone”. There is a similar subform search page under one of my main form Tab’s that uses the method below and works fine.

I think that “.txtGoToRecord” was a hidden text box that holds the current record for the filter but for the life of me i cant find it anywhere on the main form. I can only see it mentioned under parts 2 and 3 of my code.

Thanks or all your time and your help is greatly appreciated .
Kind regards all the way from Ireland. Thanks again. JAMES.

1 Filter

Private Sub btnSearch_Click()
 Me.Filter = BuildFilter
        Me.FilterOn = True
        If Me.CurrentRecord = 1 Then
            Forms!frmdcd.Filter = BuildFilter
            Forms!frmdcd.FilterOn = True
 
            Dim rst As Object
            Set rst = Me.RecordsetClone
            On Error Resume Next
            rst.MoveLast
            On Error GoTo 0
            Forms!frmdcd.txtGoToRecord.Value = Me.CurrentRecord
            Me.lblRF.Caption = "Records Found = " & rst.RecordCount
            Me.lblRF.Visible = True
 
        Else
            Forms!frmdcd.FilterOn = False
            Me.lblRF.Caption = "Records Found = 0"
            Me.lblRF.Visible = True
            Forms!frmdcd.txtGoToRecord.Value = ""
            Me.FilterOn = True
        'DoCmd.GoToRecord acDataForm, "frmDCD", acFirst
 
        End If
 

2

 Private Sub Form_Load()
DoCmd.MoveSize Right:=300, down:=300, Width:=18300, Height:=14000
Me.txtGoToRecord.Value = Me.RegNumber.Value
Me!frmChooseRegister.Visible = True
Me!frmChooseRegistrationType.Visible = False
Me!frmChooseSpecialistRegister.Visible = False
Me!frmSpecRegType.Visible = False
Me!frmFullQualFrom.Visible = False
Me!frmNursesApp.Visible = False
Me!frmTempReg.Visible = False
Me!frmRestDentist.Visible = False
Me!frmRestNurse.Visible = False
Me!frmSpecRegFull.Visible = False
Me!frmHygienistRegType.Visible = False
Me!frmHygienistQual.Visible = False
Me!frmRestSpecialist.Visible = False
Me!frmRestHygienist.Visible = False
Me!frmHygienistIrishUKApp.Visible = False
Me!frmHygienistEEAApp.Visible = False
Me!frmIrishQual.Visible = False
Me!frmEEANonEEAQual.Visible = False
Me!frmNursesRegType.Visible = False
Me!frmNursesQual.Visible = False
Me!frmEEAQual.Visible = False
Me!frmSpecRegQuals.Visible = False
Me!frmPassedExam.Visible = False
'Me!frmNewRegistration.Visible = False
'Me!frmStartScreen.Visible = True
Me!TabCtl1.Visible = True
End Sub 

3

 Private Sub TxtGoToRecord_AfterUpdate()
Dim C As Integer
s = txtGoToRecord.Value
C = DMax("RegNumber", "tblMemberDetails")
If txtGoToRecord.Value > 0 And txtGoToRecord.Value < C + 2 Then
DoCmd.GoToRecord acDataForm, "frmDCD", acGoTo, txtGoToRecord.Value
End If
End Sub 

4.My Search filter

Private Function BuildFilter() As Variant
 
    Dim varWhere As Variant
    Dim varItem As Variant
    Dim intIndex As Integer
    Dim CountyCode As Variant
    Dim NationalityCode As Variant
    Dim QualCode As Variant
 
    varWhere = Null  ' Main filter
    CountyCode = Null  ' Subfilter used for CountyCode
    NationalityCode = Null ' Subfilter used for NationalityCode
    QualCode = Null ' Subfilter used for qualCode
 
 
    ' Check for LIKE First Name
 
If Me.txtFirstName > "" Then
        varWhere = varWhere & "[FirstName] LIKE """ & Me.txtFirstName & "*"" AND "
    End If
 
    ' Check for LIKE Last Name
    If Me.txtSurname > "" Then
        varWhere = varWhere & "[surname] LIKE """ & Me.txtSurname & "*"" AND "
    End If
 
    If Me.txtRegNumber > "" Then
        varWhere = varWhere & "[regnumber] like """ & Me.txtRegNumber & """  And "
   End If
  ' Check for county in multiselect list
    For Each varItem In Me.lstCountyCode.ItemsSelected
        CountyCode = CountyCode & " [tblMemberDetails].[CountyCode] = """ & _
                    Me.lstCountyCode.ItemData(varItem) & """ OR "
 
    Next
   'Test to see if we have subfilter for colors...
    If IsNull(CountyCode) Then
        ' do nothing
    Else
        ' strip off last "OR" in the filter
        If Right(CountyCode, 4) = " OR " Then
            CountyCode = Left(CountyCode, Len(CountyCode) - 4)
        End If
 
        'Add some parentheses around the subfilter
        varWhere = varWhere & "( " & CountyCode & " ) AND "
    End If
 
 
      ' Qual Code
    For Each varItem In Me.lstqual1.ItemsSelected
        QualCode = QualCode & " [tblMemberQualifications].[qualCode] = " & _
                    Me.lstqual1.ItemData(varItem) & " OR "
 
    Next
 
    'Test to see if we have subfilter for colors...
    If IsNull(QualCode) Then
        ' do nothing
    Else
        ' strip off last "OR" in the filter
        If Right(QualCode, 4) = " OR " Then
            QualCode = Left(QualCode, Len(QualCode) - 4)
        End If
 
        'Add some parentheses around the subfilter
        varWhere = varWhere & "( " & QualCode & " ) and "
    End If
 
  'NationalityCode
 
        ' Check for Nationality in multiselect list
    For Each varItem In Me.lstNationality.ItemsSelected
        NationalityCode = NationalityCode & " [tblmemberdetails].[NationalityCode] = """ & _
                    Me.lstNationality.ItemData(varItem) & """ OR "
 
    Next
 
    'Test to see if we have subfilter for colors...
    If IsNull(NationalityCode) Then
        ' do nothing
    Else
        ' strip off last "OR" in the filter
        If Right(NationalityCode, 4) = " OR " Then
            NationalityCode = Left(NationalityCode, Len(NationalityCode) - 4)
        End If
 
        'Add some parentheses around the subfilter
        varWhere = varWhere & "( " & NationalityCode & " )  "
    End If
 
       'Check if there is a filter to return...
    If IsNull(varWhere) Then
        varWhere = "''"
    Else
 
        ' strip off last "AND" in the filter
        If Right(varWhere, 5) = " AND " Then
            varWhere = Left(varWhere, Len(varWhere) - 5)
        End If
 
    End If
 
 
    BuildFilter = varWhere
 
    End Function
 

[woodey2002]

I was missing the qualcode field in my main frm. As soon as i added it to the record source of my main form it works.

Thanks again for your time and expertise its hugely appericated.

Thanks and best of luck in the future.

Kind regaeds,

James