Text Disappears in Combo Box after Filter returns no records

[bammo]

MS Access 2003, Windows XP SP2, VBA

I have a continuous form that allows edits and filters, but not deletions or additions. I filter the form based on combining selections the user makes in several combo boxes on the form. The filter is updated whenever the user changes his/her selection.

My problem is when the user selects a filter option that is not present in the data. The filter works fine - no records are displayed; however, the text in the combo box used to build the filter disappears. This is only in the most recently changed filter selection. So say I picked Name="Fred" and got 3 results. Then I picked age="42" and I got no records and a blank 'age' combo box, but the 'Name' combo box still says "Fred". Has anyone run into this problem before and know how to fix or get around it?

On a similar form where additions are allowed, the text does not disappear from the combo box in such a situation; however, in this form, there is still one blank record displayed for inputing a new record.

This is the basic code, except the filter combines the values of several controls, rather than just one as in this ex. If you want to see more, just let me know, but I feel the problem has more to do with the form/control settings? Not sure...

 
Dim tempFilter As String
tempFilter = "A LIKE 'B'"
Form.filter = tempFilter
Form.FilterOn = True
 
 

Thanks for reading!

[ADezii]

MS Access 2003, Windows XP SP2, VBA

I have a continuous form that allows edits and filters, but not deletions or additions. I filter the form based on combining selections the user makes in several combo boxes on the form. The filter is updated whenever the user changes his/her selection.

My problem is when the user selects a filter option that is not present in the data. The filter works fine - no records are displayed; however, the text in the combo box used to build the filter disappears. This is only in the most recently changed filter selection. So say I picked Name="Fred" and got 3 results. Then I picked age="42" and I got no records and a blank 'age' combo box, but the 'Name' combo box still says "Fred". Has anyone run into this problem before and know how to fix or get around it?

On a similar form where additions are allowed, the text does not disappear from the combo box in such a situation; however, in this form, there is still one blank record displayed for inputing a new record.

This is the basic code, except the filter combines the values of several controls, rather than just one as in this ex. If you want to see more, just let me know, but I feel the problem has more to do with the form/control settings? Not sure...

 
Dim tempFilter As String
tempFilter = "A LIKE 'B'"
Form.filter = tempFilter
Form.FilterOn = True
 
 

Thanks for reading!

Please post all the relevant code.

[bammo]

My form's code:

 
' one of these for all other combo boxes, text boxes, etc...
Private Sub cmbSupplier_AfterUpdate()
    updateFilter
End Sub
 
' A separate button that clears all filters
Private Sub cmdRemoveFilter_Click()
On Error GoTo Err_cmdRemoveFilter_Click
 
    Dim db As DAO.Database
    Dim formQry As DAO.QueryDef
 
    ' Remove the filter on the subform
    'Form.FilterOn = False
    Form.filter = ""
 
    ' Set all filter selection boxes back to empty state
    cmbSupplier.Value = ""
    cmbMicro.Value = ""
    cmbCompiler.Value = ""
 
    Set db = Access.CurrentDb
    Set formQry = db.QueryDefs("qryInfo") ' set the initial query to the default form query
    Set Form.recordset = formQry.OpenRecordset()
 
Exit_cmdRemoveFilter_Click:
    Exit Sub
 
Err_cmdRemoveFilter_Click:
    MsgBox Err.Description
    Resume Exit_cmdRemoveFilter_Click
 
End Sub
 
' Function that concatenates all combo box values into one filter string
Private Sub updateFilter()
On Error GoTo Err_updateFilter
 
    Dim tempFilter As String
    Dim qry As String
 
    Dim db As DAO.Database
    Dim rst As DAO.recordset
 
    Set db = Access.CurrentDb
    tempFilter = ""
 
    If cmbSupplier.Value <> "" Then
        tempFilter = translateFilter("txtblSuppliers", "Supplier", cmbSupplier.Value)
    End If
    If cmbMicro.Value <> "" Then
        If Len(tempFilter) > 0 Then
            tempFilter = tempFilter & " AND " & _
                translateFilter("txtblMicros", "Micro", cmbMicro.Value)
        Else
            tempFilter = translateFilter("txtblMicros", "Micro", cmbMicro.Value)
        End If
    End If
    If cmbCompiler.Value <> "" Then
        If Len(tempFilter) > 0 Then
            tempFilter = tempFilter & " AND " & _
                translateFilter("txtblCompilers", "Compiler", cmbCompiler.Value)
        Else
            tempFilter = translateFilter("txtblCompilers", "Compiler", cmbCompiler.Value)
        End If
    End If
 
 
    qry = "SELECT tblL.Supplier, " _
        & "tblL.Micro, tblL.Compiler, tblA.ID " _
        & "FROM tblL INNER JOIN tblA ON " _
        & "tblL.ID = tblA.ID"
 
    If tempFilter <> "" Then
            qry = qry & " WHERE " & tempFilter & ";"
    Else
            qry = qry & ";"
    End If
 
    ' Update the form's recordset
    Set Form.recordset = db.OpenRecordset(qry)
 
Exit_updateFilter:
    Exit Sub
 
Err_updateFilter:
    MsgBox Err.Description
    Resume Exit_updateFilter
 
End Sub
 

[ADezii]

My form's code:

 
' one of these for all other combo boxes, text boxes, etc...
Private Sub cmbSupplier_AfterUpdate()
    updateFilter
End Sub
 
' A separate button that clears all filters
Private Sub cmdRemoveFilter_Click()
On Error GoTo Err_cmdRemoveFilter_Click
 
    Dim db As DAO.Database
    Dim formQry As DAO.QueryDef
 
    ' Remove the filter on the subform
    'Form.FilterOn = False
    Form.filter = ""
 
    ' Set all filter selection boxes back to empty state
    cmbSupplier.Value = ""
    cmbMicro.Value = ""
    cmbCompiler.Value = ""
 
    Set db = Access.CurrentDb
    Set formQry = db.QueryDefs("qryInfo") ' set the initial query to the default form query
    Set Form.recordset = formQry.OpenRecordset()
 
Exit_cmdRemoveFilter_Click:
    Exit Sub
 
Err_cmdRemoveFilter_Click:
    MsgBox Err.Description
    Resume Exit_cmdRemoveFilter_Click
 
End Sub
 
' Function that concatenates all combo box values into one filter string
Private Sub updateFilter()
On Error GoTo Err_updateFilter
 
    Dim tempFilter As String
    Dim qry As String
 
    Dim db As DAO.Database
    Dim rst As DAO.recordset
 
    Set db = Access.CurrentDb
    tempFilter = ""
 
    If cmbSupplier.Value <> "" Then
        tempFilter = translateFilter("txtblSuppliers", "Supplier", cmbSupplier.Value)
    End If
    If cmbMicro.Value <> "" Then
        If Len(tempFilter) > 0 Then
            tempFilter = tempFilter & " AND " & _
                translateFilter("txtblMicros", "Micro", cmbMicro.Value)
        Else
            tempFilter = translateFilter("txtblMicros", "Micro", cmbMicro.Value)
        End If
    End If
    If cmbCompiler.Value <> "" Then
        If Len(tempFilter) > 0 Then
            tempFilter = tempFilter & " AND " & _
                translateFilter("txtblCompilers", "Compiler", cmbCompiler.Value)
        Else
            tempFilter = translateFilter("txtblCompilers", "Compiler", cmbCompiler.Value)
        End If
    End If
 
 
    qry = "SELECT tblL.Supplier, " _
        & "tblL.Micro, tblL.Compiler, tblA.ID " _
        & "FROM tblL INNER JOIN tblA ON " _
        & "tblL.ID = tblA.ID"
 
    If tempFilter <> "" Then
            qry = qry & " WHERE " & tempFilter & ";"
    Else
            qry = qry & ";"
    End If
 
    ' Update the form's recordset
    Set Form.recordset = db.OpenRecordset(qry)
 
Exit_updateFilter:
    Exit Sub
 
Err_updateFilter:
    MsgBox Err.Description
    Resume Exit_updateFilter
 
End Sub
 

If I get a chance this evening, I'll have a good look at the code. Please stay in touch.

[ADezii]

My form's code:

 
' one of these for all other combo boxes, text boxes, etc...
Private Sub cmbSupplier_AfterUpdate()
    updateFilter
End Sub
 
' A separate button that clears all filters
Private Sub cmdRemoveFilter_Click()
On Error GoTo Err_cmdRemoveFilter_Click
 
    Dim db As DAO.Database
    Dim formQry As DAO.QueryDef
 
    ' Remove the filter on the subform
    'Form.FilterOn = False
    Form.filter = ""
 
    ' Set all filter selection boxes back to empty state
    cmbSupplier.Value = ""
    cmbMicro.Value = ""
    cmbCompiler.Value = ""
 
    Set db = Access.CurrentDb
    Set formQry = db.QueryDefs("qryInfo") ' set the initial query to the default form query
    Set Form.recordset = formQry.OpenRecordset()
 
Exit_cmdRemoveFilter_Click:
    Exit Sub
 
Err_cmdRemoveFilter_Click:
    MsgBox Err.Description
    Resume Exit_cmdRemoveFilter_Click
 
End Sub
 
' Function that concatenates all combo box values into one filter string
Private Sub updateFilter()
On Error GoTo Err_updateFilter
 
    Dim tempFilter As String
    Dim qry As String
 
    Dim db As DAO.Database
    Dim rst As DAO.recordset
 
    Set db = Access.CurrentDb
    tempFilter = ""
 
    If cmbSupplier.Value <> "" Then
        tempFilter = translateFilter("txtblSuppliers", "Supplier", cmbSupplier.Value)
    End If
    If cmbMicro.Value <> "" Then
        If Len(tempFilter) > 0 Then
            tempFilter = tempFilter & " AND " & _
                translateFilter("txtblMicros", "Micro", cmbMicro.Value)
        Else
            tempFilter = translateFilter("txtblMicros", "Micro", cmbMicro.Value)
        End If
    End If
    If cmbCompiler.Value <> "" Then
        If Len(tempFilter) > 0 Then
            tempFilter = tempFilter & " AND " & _
                translateFilter("txtblCompilers", "Compiler", cmbCompiler.Value)
        Else
            tempFilter = translateFilter("txtblCompilers", "Compiler", cmbCompiler.Value)
        End If
    End If
 
 
    qry = "SELECT tblL.Supplier, " _
        & "tblL.Micro, tblL.Compiler, tblA.ID " _
        & "FROM tblL INNER JOIN tblA ON " _
        & "tblL.ID = tblA.ID"
 
    If tempFilter <> "" Then
            qry = qry & " WHERE " & tempFilter & ";"
    Else
            qry = qry & ";"
    End If
 
    ' Update the form's recordset
    Set Form.recordset = db.OpenRecordset(qry)
 
Exit_updateFilter:
    Exit Sub
 
Err_updateFilter:
    MsgBox Err.Description
    Resume Exit_updateFilter
 
End Sub
 

I'm taking the code into work and having a look at it tomorrow. I'm assuming translateFilter is either a Private Function (returning a String) in the Form's Class Module, or a Public Function in a Standard Code Module. Which one is it, and please post the code for it. Will be seeing you.

[bammo]

I'm taking the code into work and having a look at it tomorrow. I'm assuming translateFilter is either a Private Function (returning a String) in the Form's Class Module, or a Public Function in a Standard Code Module. Which one is it, and please post the code for it. Will be seeing you.

Sorry about that - I am not able to read your replies, except when I reply and they are quoted in the response. I don't know whether you had other questions that I haven't addressed, but here is the code for the translateFilter function.

It is a Public Function in a Standard Code Module that can make the filter less restrictive by adding more options for the filtered fields based on entries in a database "translation" table. Ex: A is equivalent to B, C, D according to the DB translation table, so if user filters for A, also allow records with B, C, and D to pass the filter.

If my memory serves me right, however, this problem was evident prior to the addition of the translateFilter function. I think the code will still work after removing these function calls, but the text still disappears.

Thanks for taking the time to help me with this!

Public Function translateFilter(txTable As String, txName As String, txValue As String) As String
    ' Look up the txValue in the txTable and return a string
    ' that includes all matches in the filter
    Dim db As DAO.Database
    Dim qry As String
    Dim rst As DAO.recordset
    Dim tempString As String
 
    Set db = Access.CurrentDb
    qry = "SELECT " & txName & " FROM " & txTable & " WHERE " & txTable & ".Group = " & _
    "(SELECT Group FROM " & txTable & " WHERE " & txName & " = '" & txValue & "');"
 
    Set rst = db.OpenRecordset(qry)
    If Not rst.BOF And Not rst.EOF Then
        rst.MoveFirst
        tempString = "("
        While Not rst.BOF And Not rst.EOF
            tempString = tempString & txName & " LIKE """ & rst.Fields(txName) & """"
 
            rst.MoveNext
            If Not rst.EOF Then
                tempString = tempString & " OR "
            Else
                tempString = tempString & ")"
            End If
        Wend
    End If
    translateFilter = tempString
    Set rst = Nothing
    Set db = Nothing
End Function
 

[ADezii]

Sorry about that - I am not able to read your replies, except when I reply and they are quoted in the response. I don't know whether you had other questions that I haven't addressed, but here is the code for the translateFilter function.

It is a Public Function in a Standard Code Module that can make the filter less restrictive by adding more options for the filtered fields based on entries in a database "translation" table. Ex: A is equivalent to B, C, D according to the DB translation table, so if user filters for A, also allow records with B, C, and D to pass the filter.

If my memory serves me right, however, this problem was evident prior to the addition of the translateFilter function. I think the code will still work after removing these function calls, but the text still disappears.

Thanks for taking the time to help me with this!

Public Function translateFilter(txTable As String, txName As String, txValue As String) As String
    ' Look up the txValue in the txTable and return a string
    ' that includes all matches in the filter
    Dim db As DAO.Database
    Dim qry As String
    Dim rst As DAO.recordset
    Dim tempString As String
 
    Set db = Access.CurrentDb
    qry = "SELECT " & txName & " FROM " & txTable & " WHERE " & txTable & ".Group = " & _
    "(SELECT Group FROM " & txTable & " WHERE " & txName & " = '" & txValue & "');"
 
    Set rst = db.OpenRecordset(qry)
    If Not rst.BOF And Not rst.EOF Then
        rst.MoveFirst
        tempString = "("
        While Not rst.BOF And Not rst.EOF
            tempString = tempString & txName & " LIKE """ & rst.Fields(txName) & """"
 
            rst.MoveNext
            If Not rst.EOF Then
                tempString = tempString & " OR "
            Else
                tempString = tempString & ")"
            End If
        Wend
    End If
    translateFilter = tempString
    Set rst = Nothing
    Set db = Nothing
End Function
 

How about trying this Temporary Fix until, hopefully, we can resolve this issue. Enter code, similar to that posted below, to all Combo Boxes which are involved in the Filter Creation Process and let me know how you make out:

Private Sub cbmSupplier_AfterUpdate()
Dim varFilterValue As Variant
 
varFilterValue = Me![cbmSupplier]
  upDateFilter
'restore original Filter Value after updating the Filter
Me![cbmSupplier] = varFilterValue
End Sub