Applying Filters to a subform with VBA (1 Viewer)

thechazm

VBA, VB.net, C#, Java
Local time
Today, 14:56
Joined
Mar 7, 2011
Messages
515
I have a form with a subform that I send prebuilt filters too. When I select from my combo box which filter to apply it applies the filter but it does not show the filter icons above the fields on the datasheet...

Question 1: How can I get the subform datasheet to show the filter icon next to the filterd field?

Question 2: When I change the filter to "" or nothing the form does not unfilter. I even tried filteron = false but no change?

Thanks,

TheChazm
 

VilaRestal

';drop database master;--
Local time
Today, 19:56
Joined
Jun 8, 2011
Messages
1,046
By any chance are the prebuilt filters applying a where clause to the recordsource of the subform rather than changing its Filter property?
 

thechazm

VBA, VB.net, C#, Java
Local time
Today, 14:56
Joined
Mar 7, 2011
Messages
515
No. I am changing the filter property. I don't need or want to change the record source.

Here's what I have found out. The code I wrote works great but there is a sequencing issue it looks like. Let me give the scenario's.

Scenario 1:
Select Filter from combo - It filters the subform datasheet(Works)
Select Clear Filter from combo - Clears the subforms filter(Does not work)

Scenario 2:
-Select Filter from combo - It filters the subform datasheet(Works)
-Click in a cell in the datasheet
-Click Toggle Filter on the main ribbon - This then shows which fields are filtered still keeping the same filter and adds the filter Icons next to the fields.
-Select Clear Filter from combo box - Clears the subforms filter(Works)

As you can see with scenario 2 everything works but you have to click in a cell in the datasheet and toggle the filter before you select the clear filter selection in the combo box...

Is there a way I can do this programmatically by setting the focus on the subform datasheet and toggle the filter?

I have tried turning the FilterOn property on and off but this does not actually change the status of the Toggle Filter button in the ribbon?

Maybe a bug or I might be missing something either way its very confusing.
 

VilaRestal

';drop database master;--
Local time
Today, 19:56
Joined
Jun 8, 2011
Messages
1,046
Try
RunCommand acCmdRemoveAllFilters
 

thechazm

VBA, VB.net, C#, Java
Local time
Today, 14:56
Joined
Mar 7, 2011
Messages
515
Here is my code if someone can shed some light. I will try what you suggested but that is not how I want the form to work or respond. I'll let you know.

Code:
Dim tmpStr As String
On Error GoTo cboFilterFavorites_AfterUpdate_Err
    Debug.Print Me.Edit_Personnel_Sub.Form.Filter
    If (IsNull(Screen.ActiveControl) Or Screen.ActiveControl = 0) Then
        ' Clear Filters.
        'DoCmd.RunMacro "Filters.ClearFilter", , ""
        Me.Edit_Personnel_Sub.Form.Filter = ""
        Debug.Print Me.Edit_Personnel_Sub.Form.Filter
        Me.Edit_Personnel_Sub.Form.FilterOn = False
        Me.Requery
        Me.Refresh
        Me.Edit_Personnel_Sub.Form.Refresh
        Me.Edit_Personnel_Sub.Form.Requery
        Me.Edit_Personnel_Sub.SetFocus
        Exit Sub
    End If
If (Screen.ActiveControl = -1) Then
        ' Manage Filters.
        DoCmd.RunMacro "Filters.Manage", , ""
        Exit Sub
    End If
    ' Apply Filters
    tmpStr = DLookup("[Filter String]", "Filters", "[ID] = " & [Screen].[ActiveControl])
    TempVars.Add "SortString", "DLookUp(""[Sort String]"",""Filters"",""ID = "" & [Screen].[ActiveControl])"
    If (Not IsNull(tmpStr)) Then
        Me.Edit_Personnel_Sub.Form.Filter = tmpStr
        Me.Edit_Personnel_Sub.Form.FilterOn = True
        Me.Edit_Personnel_Sub.SetFocus
        Me.Form.FilterOn = True
    End If
    If (CurrentProject.IsTrusted And Not IsNull(TempVars!SortString)) Then
        OrderBy = Nz(TempVars!SortString)
    End If
    If (CurrentProject.IsTrusted) Then
        OrderByOn = Not IsNull(TempVars!SortString)
    End If
    TempVars.Remove "FilterString"
    TempVars.Remove "SortString"
    Me.Refresh
    Me.Requery
    Me.Repaint
cboFilterFavorites_AfterUpdate_Exit:
    Exit Sub
cboFilterFavorites_AfterUpdate_Err:
    MsgBox Error$
    Resume cboFilterFavorites_AfterUpdate_Exit
 

thechazm

VBA, VB.net, C#, Java
Local time
Today, 14:56
Joined
Mar 7, 2011
Messages
515
The Docmd.Runcommand accmdRemoveAllFilters does not work. I get a message saying its not available right now.
 

VilaRestal

';drop database master;--
Local time
Today, 19:56
Joined
Jun 8, 2011
Messages
1,046
Why all the requerying and refreshing:
Me.Requery
Me.Refresh
Me.Edit_Personnel_Sub.Form.Refresh
Me.Edit_Personnel_Sub.Form.Requery
? To try and solve the problem? I would get rid of them unless they're needed for some other reason. If not I'd put the FilterOn = False line after them

There's also
Me.Form.FilterOn = True
in the If (Screen.ActiveControl = -1) Then block

but that filter doesn't get switched off in the If (IsNull(Screen.ActiveControl) Or Screen.ActiveControl = 0) Then block

Could that be the filter access is keeping alive?
 

VilaRestal

';drop database master;--
Local time
Today, 19:56
Joined
Jun 8, 2011
Messages
1,046
Correction: It's not in the If (Screen.ActiveControl = -1) Then block
it's after it (the misleading indents don't help)
And after two If blocks both of which have an Exit Sub statement
I'll rewrite it a bit to make it easier to read:

Code:
    Dim tmpStr As String
    On Error GoTo cboFilterFavorites_AfterUpdate_Err
    Debug.Print Me.Edit_Personnel_Sub.Form.Filter
    If (IsNull(Screen.ActiveControl) Or Screen.ActiveControl = 0) Then
        ' Clear Filters.
        'DoCmd.RunMacro "Filters.ClearFilter", , ""
        Me.Edit_Personnel_Sub.Form.Filter = ""
        Debug.Print Me.Edit_Personnel_Sub.Form.Filter
        Me.Edit_Personnel_Sub.Form.FilterOn = False
        Me.Requery
        Me.Refresh
        Me.Edit_Personnel_Sub.Form.Refresh
        Me.Edit_Personnel_Sub.Form.Requery
        Me.Edit_Personnel_Sub.SetFocus
    ElseIf (Screen.ActiveControl = -1) Then
        ' Manage Filters.
        DoCmd.RunMacro "Filters.Manage", , ""
    Else
        ' Apply Filters
        tmpStr = DLookup("[Filter String]", "Filters", "[ID] = " & [Screen].[ActiveControl])
        TempVars.Add "SortString", "DLookUp(""[Sort String]"",""Filters"",""ID = "" & [Screen].[ActiveControl])"
        If (Not IsNull(tmpStr)) Then
            Me.Edit_Personnel_Sub.Form.Filter = tmpStr
            Me.Edit_Personnel_Sub.Form.FilterOn = True
            Me.Edit_Personnel_Sub.SetFocus
            Me.Form.FilterOn = True
        End If
        If (CurrentProject.IsTrusted And Not IsNull(TempVars!SortString)) Then
            OrderBy = Nz(TempVars!SortString)
        End If
        If (CurrentProject.IsTrusted) Then
            OrderByOn = Not IsNull(TempVars!SortString)
        End If
        TempVars.Remove "FilterString"
        TempVars.Remove "SortString"
        Me.Refresh
        Me.Requery
        Me.Repaint
    End If
cboFilterFavorites_AfterUpdate_Exit:
    Exit Sub
cboFilterFavorites_AfterUpdate_Err:
    MsgBox Error$
    Resume cboFilterFavorites_AfterUpdate_Exit
 

VilaRestal

';drop database master;--
Local time
Today, 19:56
Joined
Jun 8, 2011
Messages
1,046
And there's some definite errors in the last half of the code (undeclared variables OrderBy and OrderByOn and Nz with too few parameters).

And Screen.ActiveControl returns a control not a boolean. I think you were referring to the value of cboFilterFavorites and it would be easier to understand and less prone to bugs if the code did that.

Here's a debugged version:

Code:
    On Error GoTo cboFilterFavorites_AfterUpdate_Err
    With Me.Edit_Personnel_Sub
        Debug.Print .Form.Filter
        If (Nz(cboFilterFavorites.Value,0) = 0) Then
            ' Clear Filters.
            .Form.Filter = ""
            Debug.Print .Form.Filter
            .Form.FilterOn = False
            .SetFocus
        ElseIf cboFilterFavorites.Value = -1 Then
            ' Manage Filters.
            DoCmd.RunMacro "Filters.Manage", , ""
        Else
            ' Apply Filters
            Dim FilterString, SortString As String
            FilterString = DLookup("[Filter String]", "Filters", "ID = " & cboFilterFavorites.Value)
            SortString = DLookUp("[Sort String]","Filters","ID = " & cboFilterFavorites.Value)
            .Form.Filter = Nz(FilterString,"")
            .Form.FilterOn = Not IsNull(FilterString)
            .Form.OrderBy = Nz(SortString,"")
            .Form.OrderByOn = Not IsNull(SortString)
            .SetFocus
        End If
    End With
cboFilterFavorites_AfterUpdate_Exit:
    Exit Sub
cboFilterFavorites_AfterUpdate_Err:
    MsgBox Error$
    Resume cboFilterFavorites_AfterUpdate_Exit
 
Last edited:

thechazm

VBA, VB.net, C#, Java
Local time
Today, 14:56
Joined
Mar 7, 2011
Messages
515
Thank you. Its working just fine now. I don't understand where exactly I went wrong but yes all that extra stuff in there was because I was having a problem with the form updating so I was trying everything I could. Maybe that was bad :/
 

VilaRestal

';drop database master;--
Local time
Today, 19:56
Joined
Jun 8, 2011
Messages
1,046
I think we all resort to trial and error to solve problems sometimes.
It's important when doing that if you make a change and it doesn't fix it to comment out (or delete) that change. At best it makes the code harder to understand and debug to leave in lines that aren't needed.
 

Users who are viewing this thread

Top Bottom