Filter code slow & an error 1

[jreynold]

I apologize in advance for the ridiculous length of this post, but i figure the more info the merrier!

Okay, I have a continuous form that I am trying to upgrade to include an unbound textbox which will filter the records in an "As you type" format. I tried using Allen Browne's coding, but couldn't get it to work, so I kind of just took the concepts and added it into my code.

There's a screenshot of the form view attached if that helps.

Current Available Filters:
Option box (sorts according to project status)
Combo Supervisor (limits results to one supervisor's projects)
Combo Client (limits results to one client's projects)
Text DynFilter (As you type filter only looking at project name)

Each time any filter option is changed, the entire "anyfilterchange" sub runs.

Any ideas on how to streamline this code and make it work faster?

Also when I type something into the "dynFilter" text box that results in no records returned, I get an error message '2185' on my .selstart command saying that the control has to have focus to reference the property.... I tel it right before this to focus on that control so i'm confused. It only happens when there are no records returned.


Here's the applicable code:

Private Sub ClearProjectsFilterCompany_Click()
'Clear filter combobox ProjectsFilterCompany
Me!ProjectsFilterClient.Value = Null
Me!ProjectsFilterClient.Requery
'Run sub to update Form filter
AnyFilterChange
End Sub

Private Sub ClearProjectsFilterSupervisor_Click()
'Clear filter combobox ProjectsFilterSupervisor
Me!ProjectsFilterSupervisor.Value = Null
Me!ProjectsFilterSupervisor.Requery
'Run sub to update Form filter
ProjectsFilterSupervisor_Change
End Sub

Private Sub DynFilter_KeyUp(KeyCode As Integer, Shift As Integer)
Dim Message As String

AnyFilterChange

Me!DynFilter.SetFocus
If Nz(DynFilter.Value) <> 0 Then
Me!DynFilter.SetFocus
Me!DynFilter.SelStart = Me!DynFilter.SelLength
End If

End Sub

Private Sub ProjectName_DblClick(Cancel As Integer)
Call OpenFormToPage("Projects", 0)
End Sub

Private Sub ProjectReadyDate_DblClick(Cancel As Integer)
Call OpenFormToPage("Projects", 0)
End Sub

Private Sub ProjectsFilterActiveOption_AfterUpdate()
AnyFilterChange
End Sub

Private Sub ProjectsFilterClient_Change()
AnyFilterChange
End Sub

Private Sub ProjectsFilterSupervisor_Change()
AnyFilterChange
End Sub

Private Sub AnyFilterChange()

Dim SetFilter As String
Dim FiltOpt As Byte
Dim StrDynFilter As String
Dim StrTodos

FiltOpt = Me!ProjectsFilterActiveOption
StrTodos = "*"

'Reset filter string to nothing
SetFilter = "1=1"

'Determine selected filters and if selected add to main filter string

'Default Ordering for Form
Me.OrderByOn = True
Me.OrderBy = "CompanyName ASC, ProjectName ASC"

'clear project client filter if otions 4 5 or 6 or selected
If FiltOpt = 4 Or FiltOpt = 5 Or FiltOpt = 6 Then
Me!ProjectsFilterClient.Enabled = "False"
Me!ProjectsFilterClient.Value = Null
Me!ProjectsFilterClient.Requery
Else
Me!ProjectsFilterClient.Enabled = "True"
End If

If IsNull(Me!ProjectsFilterClient) = False Then
SetFilter = SetFilter & " AND ((CompanyName='" & Me!ProjectsFilterClient & "'))"
End If

If IsNull(Me!ProjectsFilterSupervisor) = False Then
SetFilter = SetFilter & " AND ((Supervisor='" & Me!ProjectsFilterSupervisor & "'))"
End If

If FiltOpt = 1 Then 'active projects
SetFilter = SetFilter & " AND " & "(([Projects-All].ProjectIsInactive=0))"
End If

If FiltOpt = 2 Then 'inactive projects
SetFilter = SetFilter & " AND " & "(([Projects-All].ProjectIsInactive=-1))"
End If

If FiltOpt = 4 Then 'Upcoming Projects
SetFilter = SetFilter & " and " & "([Projects-all].ProjectReadydate < (date()+31))" & " AND " & "(([Projects-All].ProjectIsReportCompiled=0))" & " AND " & "(([Projects-All].ProjectIsInactive=0))"
Me.OrderBy = "[Projects-all].ProjectReadyDate ASC"
End If

If FiltOpt = 5 Then 'Reports To Write (write report = false, active = yes, fieldwork% >89)
SetFilter = SetFilter & " AND " & "[Projects-all].ProjectIsReportCompiled = False" & " AND " & "[Projects-all].ProjectIsReportCompiled = False" & " AND " & "[Projects-all].FieldworkPercentComplete > 89"
End If

If FiltOpt = 6 Then 'Reports to review
SetFilter = SetFilter & " AND " & "[Projects-all].ProjectIsReportCompiled = True" & " AND " & "[Projects-all].ProjectIsReportReviewed = False"
End If

'Dynamic "as you type" filtering through textbox
If Nz(DynFilter.Value) <> 0 Then
StrDynFilter = DynFilter.Value
SetFilter = SetFilter & "AND" & "[ProjectName] Like '" & StrTodos & StrDynFilter & StrTodos & "'"
End If

'Filter the form
'If no filters the form will show all records

If SetFilter = "" Then
DoCmd.ShowAllRecords
Else
DoCmd.ApplyFilter , SetFilter
End If

End Sub





THANK YOU FOR ANY HELP!!!! Obviously from my code I kind of shoot from the hip on this stuff.

 

[Golom]

Your code looks pretty clean. Just a couple of things to note

- In the FiltOpt = 5 case, you have the same field twice. From your comment I infer that "ProjectIsInactive = False" should be included there.

- "1=1" tends to slow down the execution because it gets evaluated on every record ... even though it's obvious that the result (True) is always the same. Further, with SetFilter initially set to "1=1", the "DoCmd.ShowAllRecords" will never be executed because SetFilter is never an empty string (although "1=1" should have the same effect.)

- I have found that doing a search with every keypress tends to be meaningless for the first few keystrokes. For example, typing "A" in your textbox will result in a rather long list of projects but there's probably no significance to the fact that all those project names contain "A". Perhaps you want to update the search only when the user presses ENTER in the text box.

- Don't know about the textbox error. This is not the code where it's happening.

Try this

Private Sub AnyFilterChange()

    Dim SetFilter                   As String
    Dim FiltOpt                     As Byte

    FiltOpt = Me!ProjectsFilterActiveOption

    'Reset filter string to nothing
    SetFilter = ""

    'Determine selected filters and if selected add to main filter string

    'Default Ordering for Form
    Me.OrderByOn = True
    Me.OrderBy = "CompanyName ASC, ProjectName ASC"

    'Clear project client filter if otions 4 5 or 6 or selected
    If FiltOpt = 4 Or FiltOpt = 5 Or FiltOpt = 6 Then
        Me!ProjectsFilterClient.Enabled = "False"
        Me!ProjectsFilterClient.Value = Null
        Me!ProjectsFilterClient.Requery
    Else
        Me!ProjectsFilterClient.Enabled = "True"
    End If

    If Not IsNull(Me!ProjectsFilterClient) Then
        SetFilter = SetFilter & _
                    " AND CompanyName='" & Me!ProjectsFilterClient & "'"
    End If

    If Not IsNull(Me!ProjectsFilterSupervisor) Then
        SetFilter = SetFilter & _
                    " AND Supervisor='" & Me!ProjectsFilterSupervisor & "'"
    End If

    Select Case FiltOpt

        Case 1    ' Active projects
            SetFilter = SetFilter & _
                        " AND [Projects-All].ProjectIsInactive=False"

        Case 2    ' Inactive projects
            SetFilter = SetFilter & _
                        " AND [Projects-All].ProjectIsInactive=True"

        Case 3    ' All Projects
            SetFilter = ""

        Case 4    ' Upcoming Projects
            SetFilter = SetFilter & _
                        " AND [Projects-all].ProjectReadydate < (Date()+31)" & _
                        " AND [Projects-All].ProjectIsReportCompiled = False" & _
                        " AND [Projects-All].ProjectIsInactive = False"
            Me.OrderBy = "[Projects-all].ProjectReadyDate ASC"

        Case 5    ' Reports To Write (write report = false, active = yes, fieldwork% >89)
            SetFilter = SetFilter & _
                        " AND [Projects-all].ProjectIsReportCompiled = False" & _
                        " AND [Projects-all].ProjectIsInactive = False" & _
                        " AND [Projects-all].FieldworkPercentComplete > 89"

        Case 6    ' Reports to review
            SetFilter = SetFilter & _
                        " AND [Projects-all].ProjectIsReportCompiled = True" & _
                        " AND [Projects-all].ProjectIsReportReviewed = False"

    End Select

    'Dynamic "as you type" filtering through textbox
    If Nz(DynFilter.Value, 0) <> 0 Then
        SetFilter = SetFilter & _
                    " AND [ProjectName] LIKE '*" & DynFilter.Value & "*'"
    End If

    ' Trim off the starting " AND " if SetFilter contains data.
    If Len(SetFilter) > 0 Then
        SetFilter = Mid$(SetFilter, 6)
    End If

    'Filter the form
    'If no filters the form will show all records
    If Len(SetFilter) > 0 Then
        DoCmd.ShowAllRecords
    Else
        DoCmd.ApplyFilter , SetFilter
    End If

End Sub

 

[jreynold]

Thank you so much Golom! I was hoping for some constructive criticism on bits an pieces, but you helped out way more then that. I didn't try timing the speed of it or anything, but it seems faster to me, we'll see what eveyone else thinks

I also found in the Allen Browne code for FindAsUType that I looked at when writing the search box code that he had an error handler set to ignore the very error I was getting. I added that and have had no more problems.

Thanks again!