Solved Help with dynamic search on form with read only recordset

MajP said:
Personally I would write one procedure so you do not have to update each and every one. But if you want to try one. Try this
Code: 
Private Sub txtNumberFilter_Change()

Dim sText As String
Dim strFilter As String
  ' On Error GoTo ErrHandler
   sText = Me!txtNumberFilter.Text
   If sText <> "" Then
        strFilter = "[OrderNumber] Like '*" & sText & "*'"
        Me.Filter = strFilter
        Me.FilterOn = True
    Else
        Me.Filter = ""
        Me.FilterOn = False
    End If
 
   If Me.Recordset.RecordCount = 0 Then
     MsgBox "No records match " & Me.Filter, vbInformation, "No Match"
     Me.FilterOn = False
     DoEvents
     Me.txtNumberFilter.SetFocus
     sText = Left(Me.txtNumberFilter.Text, Len(txtNumberFilter.Text) - 1)
     Me.txtNumberFilter.Value = sText
     Me.Filter = "[OrderNumber] Like '*" & sText & "*'"
     Me.FilterOn = True
  End If
      With Me.txtNumberFilter
        .SetFocus
        .Value = sText
        .SetFocus
        .SelStart = Len(sText)
        .SelLength = 0
      End With

    Exit Sub
ErrHandler:
    MsgBox Err.Description, vbExclamation

End Sub
Click to expand...
MajP, this works perfectly, but it seems if I could understand your comment "Personally I would write one procedure so you do not have to update each and every one" - then I would become a better code writer - I tried your previous code with the "If Not Trim...." but I think it is calling for functions or subs you have written and I am not sure I am skilled enough yet to follow.
Wow, if I ever do figure this stuff out I will have a lot of clean up to I'll bet.
Thanks so much to you and all the others willing to help out a newbie trying to make his regular job easier!
 
We may have posted at same time. But you should be able to simply drop the procedure I posted and then write very small procedures to call it. Should take very little time. The new procedures are one liners.
 
Actually you can go one step further. You can drop this procedure into a standard module not a forms module.

Then you can call this for each of your forms. You will have one procedure that works on all search boxes on all forms. That should save a ton of code writing.
Code: 
Public Sub FilterByControl(ctrl as access.control, filterField as string)
 Dim sText As String
 Dim strFilter As String
 dim frm as access.form

 set frm = ctrl.parent
' On Error GoTo ErrHandler
   sText = ctrl.text
   If sText <> "" Then
        strFilter = "[" & FilterField & "] Like '*" & sText & "*'"
        frm.Filter = strFilter
        frm.FilterOn = True
    Else
        frm.Filter = ""
        frm.FilterOn = False
    End If
  
   If frm.Recordset.RecordCount = 0 Then
     MsgBox "No records match " & frm.Filter, vbInformation, "No Match"
     frm.FilterOn = False
     DoEvents
     ctrl.SetFocus
     sText = Left(ctrl.Text, Len(ctrl.Text) - 1)
     ctrl.Value = sText
     frm.Filter = "[" & FilterField & "] Like '*" & sText & "*'"
     frm.FilterOn = True
  End If
      With ctrl
        .SetFocus
        .Value = sText
        .SetFocus
        .SelStart = Len(sText)
        .SelLength = 0
      End With
 
    Exit Sub
ErrHandler:
    MsgBox Err.Description, vbExclamation

End Sub
 
MajP said:
Actually you can go one step further. You can drop this procedure into a standard module not a forms module.

Then you can call this for each of your forms. You will have one procedure that works on all search boxes on all forms. That should save a ton of code writing.
Code: 
Public Sub FilterByControl(ctrl as access.control, filterField as string)
Dim sText As String
Dim strFilter As String
dim frm as access.form

set frm = ctrl.parent
' On Error GoTo ErrHandler
   sText = ctrl.text
   If sText <> "" Then
        strFilter = "[" & FilterField & "] Like '*" & sText & "*'"
        frm.Filter = strFilter
        frm.FilterOn = True
    Else
        frm.Filter = ""
        frm.FilterOn = False
    End If
 
   If frm.Recordset.RecordCount = 0 Then
     MsgBox "No records match " & frm.Filter, vbInformation, "No Match"
     frm.FilterOn = False
     DoEvents
     ctrl.SetFocus
     sText = Left(ctrl.Text, Len(ctrl.Text) - 1)
     ctrl.Value = sText
     frm.Filter = "[" & FilterField & "] Like '*" & sText & "*'"
     frm.FilterOn = True
  End If
      With ctrl
        .SetFocus
        .Value = sText
        .SetFocus
        .SelStart = Len(sText)
        .SelLength = 0
      End With

    Exit Sub
ErrHandler:
    MsgBox Err.Description, vbExclamation

End Sub
Click to expand...
Awesome but I have one question - I have multiple search boxes on each form, do I set the variable filterfield in each of the form subs before calling the function?
Thanks
 
MajP said:
You have lots of these procedures.


Code: 
Private Sub txtNumberFilter_Change()


Dim sText As String
Dim strFilter As String
  ' On Error GoTo ErrHandler
   sText = Me!txtNumberFilter.Text
   If sText <> "" Then
        strFilter = "[OrderNumber] Like '*" & sText & "*'"
        Me.Filter = strFilter
        Me.FilterOn = True
    Else
        Me.Filter = ""
        Me.FilterOn = False
    End If
 
   If Me.Recordset.RecordCount = 0 Then
     MsgBox "No records match " & Me.Filter, vbInformation, "No Match"
     Me.FilterOn = False
     DoEvents
     Me.txtNumberFilter.SetFocus
     sText = Left(Me.txtNumberFilter.Text, Len(txtNumberFilter.Text) - 1)
     Me.txtNumberFilter.Value = sText
     Me.Filter = "[OrderNumber] Like '*" & sText & "*'"
     Me.FilterOn = True
  End If
      With Me.txtNumberFilter
        .SetFocus
        .Value = sText
        .SetFocus
        .SelStart = Len(sText)
        .SelLength = 0
      End With

    Exit Sub
ErrHandler:
    MsgBox Err.Description, vbExclamation


End Sub

you could make one procedure

Code: 
Public Sub FilterByControl(ctrl as access.control, filterField as string)
Dim sText As String
Dim strFilter As String
' On Error GoTo ErrHandler
   sText = ctrl.text
   If sText <> "" Then
        strFilter = "[" & FilterField & "] Like '*" & sText & "*'"
        Me.Filter = strFilter
        Me.FilterOn = True
    Else
        Me.Filter = ""
        Me.FilterOn = False
    End If
 
   If Me.Recordset.RecordCount = 0 Then
     MsgBox "No records match " & Me.Filter, vbInformation, "No Match"
     Me.FilterOn = False
     DoEvents
     ctrl.SetFocus
     sText = Left(ctrl.Text, Len(ctrl.Text) - 1)
     ctrl.Value = sText
     Me.Filter = "[" & FilterField & "] Like '*" & sText & "*'"
     Me.FilterOn = True
  End If
      With ctrl
        .SetFocus
        .Value = sText
        .SetFocus
        .SelStart = Len(sText)
        .SelLength = 0
      End With

    Exit Sub
ErrHandler:
    MsgBox Err.Description, vbExclamation


End Sub

then call it like
Code: 
Private Sub txtNumberFilter_Change()
  FilterByControl me.txtNumberFilter, "OrderNumber"
end sub
Click to expand...
Ah, I see, thanks again!
 
I tested in yours and replaced your code by dropping mine into a standard module.
then in your form your code becomes
Code: 
Private Sub txtContactFilter_Change()
  FilterByControl Me.txtContactFilter, "Contact"
End Sub

Private Sub txtCustFilter_Change()
  FilterByControl Me.txtCustFilter, "Customer"
End Sub

Private Sub txtDateFilter_Change()
  FilterByControl Me.txtDateFilter, "OrderDate"
End Sub

Private Sub txtJobNameFilter_Change()
  FilterByControl Me.txtJobNameFilter, "JobName"
End Sub

Private Sub txtLocationFilter_Change()
  FilterByControl Me.txtLocationFilter, "Location"
End Sub

Private Sub txtNumberFilter_Change()
  FilterByControl Me.txtNumberFilter, "OrderNumber"
End Sub

Private Sub txtPOFilter_Change()
  FilterByControl Me.txtPOFilter, "PONum"
End Sub

That saved about 150 lines of code. So doing it this way should save quite a lot of code and error checking.

FYI for this to work your dates and numerics will have to be converted to strings in the query. I di not try oderdate, but if the field is a date it will fail.
 
MajP said:
I tested in yours and replaced your code by dropping mine into a standard module.
then in your form your code becomes
Code: 
Private Sub txtContactFilter_Change()
  FilterByControl Me.txtContactFilter, "Contact"
End Sub

Private Sub txtCustFilter_Change()
  FilterByControl Me.txtCustFilter, "Customer"
End Sub

Private Sub txtDateFilter_Change()
  FilterByControl Me.txtDateFilter, "OrderDate"
End Sub

Private Sub txtJobNameFilter_Change()
  FilterByControl Me.txtJobNameFilter, "JobName"
End Sub

Private Sub txtLocationFilter_Change()
  FilterByControl Me.txtLocationFilter, "Location"
End Sub

Private Sub txtNumberFilter_Change()
  FilterByControl Me.txtNumberFilter, "OrderNumber"
End Sub

Private Sub txtPOFilter_Change()
  FilterByControl Me.txtPOFilter, "PONum"
End Sub

That saved about 150 lines of code. So doing it this way should save quite a lot of code and error checking.

FYI for this to work your dates and numerics will have to be converted to strings in the query. I di not try oderdate, but if the field is a date it will fail.
Click to expand...
Wow, Thank you!!
I am marking this thread as solved :)
 
You must log in or register to reply here.

Similar threads

H
Problem with Search Boxes
2
Replies
24
Views
926
Pat Hartman
P
I
Dynamic/reusable forms
4 5 6
Replies
111
Views
3,768
Imb
I
H
Solved Search across multiple fields
Replies
8
Views
579
Harry Paraskeva
H
K
Solved linking text box with after_update procedure using VBA.
Replies
17
Views
702
Kingz
K
J
Read Only Message
Replies
6
Views
231
Gasman
Gasman

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom