vbams-accessfilterrecord-count

Access VBA Filter RecordCount not properly updating value


I have a form that I have built a filter search on that runs "after_update". When the filter results in no records the form fails and shows blank. To get around this i found several posts recommending to add a "RecordCount" and use an "if" statement to then trigger the filter if it is not <1 or =0. My issue is that the value of the RecordCount seems to be showing the # of records from the last ran filter selections, not the current filter. I have tried several methods to "requery" and update the value of the RecordCount after the filter is applied but I cant get it to update as i intend it to work.

Example:

Filter 1: Results in 14 records, the debug.print recordcount displays 1

Filter 2: Results in 22 records, the debug.print recordcount displays 14

Filter 3: Results in 0 records, Form fails, the debug.print recordcount displays 22

Code:

Private Sub ApplyFilterBtn_Click()
On Error GoTo Err_ApplyFilterBtn_Click

Dim stFilter As String

stFilter = ""

If Nz(Me.FilterOwner, "") <> "" Then
    stFilter = stFilter & "[MachineOwner] = " & Me.FilterOwner & " AND "
End If

If Nz(Me.FilterType, "") <> "" Then
    stFilter = stFilter & "[MachineType] = " & Me.FilterType & " AND "
End If

If Nz(Me.FilterSubType, "") <> "" Then
    stFilter = stFilter & "[MachineSubType] = " & Me.FilterSubType & " AND "
End If

If Nz(Me.FilterMake, "") <> "" Then
    stFilter = stFilter & "[Make] Like '" & Me.FilterMake & "' AND "
End If

If Nz(Me.FilterModel, "") <> "" Then
    stFilter = stFilter & "[Model] Like '*" & Me.FilterModel & "*' AND "
End If

If Nz(Me.FilterSN, "") <> "" Then
    stFilter = stFilter & "[SN] Like '" & Me.FilterSN & "' AND "
End If

If Nz(Me.FilterStatus, "") <> "" Then
    stFilter = stFilter & "[NewStatus] = " & Me.FilterStatus & " AND "
End If



If stFilter <> "" Then
    stFilter = Left(stFilter, Len(stFilter) - 5) 'Remove the extra AND

'<<<<<<<Issue starts here<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
    Me.Recordset.Clone

      Me.RecordsetClone.Filter = stFilter
        Me.RecordsetClone.MoveLast
'       Me.RecordsetClone.MoveNext  'Tried this - did not help
'        Me.RecordsetClone.Requery  'tried this - did not help

'        Me.Filter = stFilter    ' Tries this - did not help

        'debugging to see value of RecordCount
        Debug.Print stFilter
        Debug.Print Me.RecordsetClone.RecordCount

'>>>>>> Recordsetclone.RecordCount value not refreshing properly above, shows previously called filter record count

  If Me.RecordsetClone.RecordCount < 1 Then  ' no records, don't filter
        'If Not (Me.RecordsetClone.BOF And Me.RecordsetClone.EOF) Then  'work around attempt 2 - failed
        'If Me.NoMatch Then                                             'Work around Attempt 3 - failed
            RemoveFilterBtn_Click ' Call sub that Clears filter
            MsgBox "Filter Results in No records", vbOKOnly, "No Results"
        Else ' there are records, turn on filter
            Me.Filter = stFilter
            Me.FilterOn = True
        End If 'Me.RecordCount < 1
    Else
        Me.FilterOn = False
        RemoveFilterBtn_Click ' Clears filter
    End If 'stFilter <> ""

Exit_ApplyFilterBtn_Click:
        Exit Sub

Err_ApplyFilterBtn_Click:
        MsgBox Err.Description
        Resume Exit_ApplyFilterBtn_Click

End Sub


Private Sub RemoveFilterBtn_Click()
On Error GoTo Err_RemoveFilterBtn_Click

    'Sets Filter Field Values to Blank
    Me.FilterOwner = ""
    Me.FilterType = ""
    Me.FilterMake = ""
    Me.FilterModel = ""
    Me.FilterSN = ""
    Me.FilterStatus = ""
    Me.FilterSubType = ""

    'Removes Filter
    Me.Filter = ""
    Me.FilterOn = False

Exit_RemoveFilterBtn_Click:
    Exit Sub

Err_RemoveFilterBtn_Click:
    MsgBox Err.Description
    Resume Exit_RemoveFilterBtn_Click

End Sub

Solution

  • It is simpler but you need the right syntax:

    Dim rst As DAO.Recordset
    Dim rstFiltered As DAO.Recordset
    
    Set rst = Me.RecordsetClone
    rst.Filter = stFilter
    
    Set rstFiltered = rst.OpenRecordset()
    If rstFiltered.RecordCount > 0 Then
    
        ' Do stuff.
    
    End If
    rstFiltered.Close
    
    Set rstFiltered = Nothing
    Set rst = Nothing