ListBox & Filter Question

D

d9pierce

Hi all,
I have a Form!Frm_Main_Phone and it is a bound form from Tbl_Company.

I first set this form up with a list box with the detailed info from
companies and a few simple controls to dblClick, Click, and misc... I
attached a grpCmdButtons for a phone like control, (#, A.B.C.D....) and
that works fine. Well, I want a way to further filter through these
list, as they are quite long and time consuming to say the least. I
found a form filter called search 2000 which works great for forms, but
I have not been able to figure out how to apply this to my ListBox at
all nor not to mention include the grpFilter with in this. I have spent
many days trying different ways to do this but I need some help here.

Below you will find the code I am using and I would like to know if
anyone could help out with how to use the latter code in a list box and
how to include the grpfunction with it or if I have to create 27 new
buttons and detail each *A*, *B*, ...

I would really love some help with this.

Thank you all so much, I love this group!

Option Compare Database
Option Explicit







Private Sub CompanyPhoneList_DblClick(Cancel As Integer)
DoCmd.OpenForm "Frm_Company_Main", , , "[CompanyID]=" &
Me![CompanyPhoneList].Column(0)
End Sub



Private Sub Form_Current()
Me.CompanyPhoneList = Me.CompanyName
End Sub

Private Sub grpCompanyFilter_Click()
Select Case grpCompanyFilter
Case 1
Me.TxtCompanyFilter = "A"
' MsgBox "Select * FROM Tbl_Company WHERE CompanyName Like
""" & TxtCompanyFilter & "*"""
' Me.RecordSource = "Select * FROM Tbl_Company WHERE
CompanyName Like """ & TxtCompanyFilter & "*"""
' Me.Requery
Me.CompanyPhoneList.Requery
Case 2
Me.TxtCompanyFilter = "B"
Me.CompanyPhoneList.Requery
Case 3
Me.TxtCompanyFilter = "C"
Me.CompanyPhoneList.Requery
Case 4
Me.TxtCompanyFilter = "D"
Me.CompanyPhoneList.Requery
Case 5
Me.TxtCompanyFilter = "E"
Me.CompanyPhoneList.Requery
Case 6
Me.TxtCompanyFilter = "F"
Me.CompanyPhoneList.Requery
Case 7
Me.TxtCompanyFilter = "G"
Me.CompanyPhoneList.Requery
Case 8
Me.TxtCompanyFilter = "H"
Me.CompanyPhoneList.Requery
Case 9
Me.TxtCompanyFilter = "I"
Me.CompanyPhoneList.Requery
Case 10
Me.TxtCompanyFilter = "J"
Me.CompanyPhoneList.Requery
Case 11
Me.TxtCompanyFilter = "K"
Me.CompanyPhoneList.Requery
Case 12
Me.TxtCompanyFilter = "L"
Me.CompanyPhoneList.Requery
Case 13
Me.TxtCompanyFilter = "M"
Me.CompanyPhoneList.Requery
Case 14
Me.TxtCompanyFilter = "N"
Me.CompanyPhoneList.Requery
Case 15
Me.TxtCompanyFilter = "O"
Me.CompanyPhoneList.Requery
Case 16
Me.TxtCompanyFilter = "P"
Me.CompanyPhoneList.Requery
Case 17
Me.TxtCompanyFilter = "Q"
Me.CompanyPhoneList.Requery
Case 18
Me.TxtCompanyFilter = "R"
Me.CompanyPhoneList.Requery
Case 19
Me.TxtCompanyFilter = "S"
Me.CompanyPhoneList.Requery
Case 20
Me.TxtCompanyFilter = "T"
Me.CompanyPhoneList.Requery
Case 21
Me.TxtCompanyFilter = "U"
Me.CompanyPhoneList.Requery
Case 22
Me.TxtCompanyFilter = "V"
Me.CompanyPhoneList.Requery
Case 23
Me.TxtCompanyFilter = "W"
Me.CompanyPhoneList.Requery
Case 24
Me.TxtCompanyFilter = "X"
Me.CompanyPhoneList.Requery
Case 25
Me.TxtCompanyFilter = "Y"
Me.CompanyPhoneList.Requery
Case 26
Me.TxtCompanyFilter = "Z"
Me.CompanyPhoneList.Requery
Case 27
Me.TxtCompanyFilter = "*"
Me.CompanyPhoneList.Requery
Case 28
Me.TxtCompanyFilter = "#"
Me.CompanyPhoneList.Requery

End Select
Me.RecordSource = "Select * FROM Tbl_Company WHERE
CompanyName Like """ & TxtCompanyFilter & "*"""
Me.Requery


End Sub


Private Sub FrmClose_Click()
DoCmd.Close
End Sub

Private Sub FrmDelete_Click()
DoCmd.OpenForm "Frm_Company_Main", , , "[CompanyID]=" &
Me![CompanyPhoneList].Column(0)
Forms!Frm_Company_Main.Caption = "Delete Company"
Forms!Frm_Company_Main.FrmDelete.Enabled = True
Forms!Frm_Company_Main.FrmAdd.Enabled = False
End Sub

Private Sub FrmAdd_Click()
DoCmd.OpenForm "Frm_Company_Main", dataMode:=acFormAdd
Forms!Frm_Company_Main.Caption = "ADD Company"
Forms!Frm_Company_Main.CancelNew.Enabled = True
End Sub



'Purpose: This module illustrates how to create a search form, _
where the user can enter as many or few criteria as they
wish, _
and results are shown one per line.
'Note: Only records matching ALL of the criteria are returned.


Private Sub cmdFilter_Click()
'Purpose: Build up the criteria string form the non-blank search
boxes, and apply to the form's Filter.
'Notes: 1. We tack " AND " on the end of each condition so you
can easily add more search boxes; _
we remove the trailing " AND " at the end.
' 2. The date range works like this: _
Both dates = only dates between (both
inclusive. _
Start date only = all dates from this one
onwards; _
End date only = all dates up to (and
including this one).
Dim strWhere As String 'The criteria string.
Dim lngLen As Long 'Length of the criteria
string to append to.
Const conJetDate = "\#mm\/dd\/yyyy\#" 'The format expected for
dates in a JET query string.


'***********************************************************************
'Look at each search box, and build up the criteria string from the
non-blank ones.

'***********************************************************************

'Another text field example. Use Like to find anywhere in the
field.
If Not IsNull(Me.TxtFilterCompanyName) Then
strWhere = strWhere & "([CompanyName] Like ""*" &
Me.TxtFilterCompanyName & "*"") AND "
End If


'Another text field example. Use Like to find anywhere in the
field.
If Not IsNull(Me.TxtFilterPhone) Then
strWhere = strWhere & "([Phone] Like ""*" & Me.TxtFilterPhone &
"*"") AND "
End If

'Number field example. Do not add the extra quotes.
If Not IsNull(Me.CboFilterCompanyType) Then
strWhere = strWhere & "(CompanyType = " &
Me.CboFilterCompanyType & ") AND "
End If

'Number field example. Do not add the extra quotes.
If Not IsNull(Me.CboFilterPrimaryTrade) Then
strWhere = strWhere & "(PrimaryTrade = " &
Me.CboFilterPrimaryTrade & ") AND "

End If
'Number field example. Do not add the extra quotes.
If Not IsNull(Me.CboFilterStatus) Then
strWhere = strWhere & "(Status = " & Me.CboFilterStatus & ")
AND "

End If

'Number field example. Do not add the extra quotes.
If Not IsNull(Me.CboFilterWorkArea) Then
strWhere = strWhere & "(WorkArea = " & Me.CboFilterWorkArea &
") AND "

End If

'Number field example. Do not add the extra quotes.
If Not IsNull(Me.CboFilterState) Then
strWhere = strWhere & "(State = " & Me.CboFilterState & ") AND
"

End If




'***********************************************************************
'Chop off the trailing " AND ", and use the string as the form's
Filter.

'***********************************************************************
'See if the string has more than 5 characters (a trailng " AND ")
to remove.
lngLen = Len(strWhere) - 5
If lngLen <= 0 Then 'Nah: there was nothing in the string.
MsgBox "No criteria", vbInformation, "Nothing to do."
Else 'Yep: there is something there, so remove
the " AND " at the end.
strWhere = Left$(strWhere, lngLen)
'For debugging, remove the leading quote on the next line.
Prints to Immediate Window (Ctrl+G).
'Debug.Print strWhere

'Finally, apply the string as the form's Filter.
Me.Filter = strWhere
Me.FilterOn = True
End If

End Sub

Private Sub cmdReset_Click()
'Purpose: Clear all the search boxes in the Form Footer, and show
all records again.
Dim ctl As Control

'Clear all the controls in the Form Footer section.
For Each ctl In Me.Section(acFooter).Controls
Select Case ctl.ControlType
Case acTextBox, acComboBox
ctl.Value = Null
Case acCheckBox
ctl.Value = False
End Select
Next

'Remove the form's filter.
Me.FilterOn = False

End Sub

Private Sub Form_BeforeInsert(Cancel As Integer)
'To avoid problems if the filter returns no records, we did not set
its AllowAdditions to No.
'We prevent new records by cancelling the form's BeforeInsert event
instead.
'The problems are explained at http://allenbrowne.com/bug-06.html
Cancel = True
MsgBox "You cannot add new clients to the search form.",
vbInformation, "Permission denied."
End Sub
 
S

strive4peace

Hello,

you need another quote mark --> """" instead of """ at
beginning of your filter -- or you can do "'"

in a string, if you want a double quote mark and your string
is delimited with double quote marks, you need 2 of them inside

also, instead of redefining the recordset, just set the
FILTER property for the form

also
chr(65) = "A" ...
chr(90) = "Z"

try this:

'---------------------------
Private Sub grpCompanyFilter_AfterUpdate()
dim mFilter as string
if not isnull(me.grpCompanyFilter) then
mFilter = "Left(CompanyName,1) = '" _
& chr(64 + me.grpCompanyFilter) & "'"
me.filter = mFilter
me.FilterOn = true
else
'show all records
me.FilterOn = false
end if
me.requery
End Sub
'---------------------------

then, you can use the form OnCurrent event to filter the
company phone list so that it changes when you change the
company (assuming it is tied to your companyID)
'---------------------------
Me.CompanyPhoneList.Requery
'---------------------------

Have an awesome day

Warm Regards,
Crystal

MVP Microsoft Access

remote programming and training
strive4peace2006 at yahoo.com


Hi all,
I have a Form!Frm_Main_Phone and it is a bound form from Tbl_Company.

I first set this form up with a list box with the detailed info from
companies and a few simple controls to dblClick, Click, and misc... I
attached a grpCmdButtons for a phone like control, (#, A.B.C.D....) and
that works fine. Well, I want a way to further filter through these
list, as they are quite long and time consuming to say the least. I
found a form filter called search 2000 which works great for forms, but
I have not been able to figure out how to apply this to my ListBox at
all nor not to mention include the grpFilter with in this. I have spent
many days trying different ways to do this but I need some help here.

Below you will find the code I am using and I would like to know if
anyone could help out with how to use the latter code in a list box and
how to include the grpfunction with it or if I have to create 27 new
buttons and detail each *A*, *B*, ...

I would really love some help with this.

Thank you all so much, I love this group!

Option Compare Database
Option Explicit







Private Sub CompanyPhoneList_DblClick(Cancel As Integer)
DoCmd.OpenForm "Frm_Company_Main", , , "[CompanyID]=" &
Me![CompanyPhoneList].Column(0)
End Sub



Private Sub Form_Current()
Me.CompanyPhoneList = Me.CompanyName
End Sub

Private Sub grpCompanyFilter_Click()
Select Case grpCompanyFilter
Case 1
Me.TxtCompanyFilter = "A"
' MsgBox "Select * FROM Tbl_Company WHERE CompanyName Like
""" & TxtCompanyFilter & "*"""
' Me.RecordSource = "Select * FROM Tbl_Company WHERE
CompanyName Like """ & TxtCompanyFilter & "*"""
' Me.Requery
Me.CompanyPhoneList.Requery
Case 2
Me.TxtCompanyFilter = "B"
Me.CompanyPhoneList.Requery
Case 3
Me.TxtCompanyFilter = "C"
Me.CompanyPhoneList.Requery
Case 4
Me.TxtCompanyFilter = "D"
Me.CompanyPhoneList.Requery
Case 5
Me.TxtCompanyFilter = "E"
Me.CompanyPhoneList.Requery
Case 6
Me.TxtCompanyFilter = "F"
Me.CompanyPhoneList.Requery
Case 7
Me.TxtCompanyFilter = "G"
Me.CompanyPhoneList.Requery
Case 8
Me.TxtCompanyFilter = "H"
Me.CompanyPhoneList.Requery
Case 9
Me.TxtCompanyFilter = "I"
Me.CompanyPhoneList.Requery
Case 10
Me.TxtCompanyFilter = "J"
Me.CompanyPhoneList.Requery
Case 11
Me.TxtCompanyFilter = "K"
Me.CompanyPhoneList.Requery
Case 12
Me.TxtCompanyFilter = "L"
Me.CompanyPhoneList.Requery
Case 13
Me.TxtCompanyFilter = "M"
Me.CompanyPhoneList.Requery
Case 14
Me.TxtCompanyFilter = "N"
Me.CompanyPhoneList.Requery
Case 15
Me.TxtCompanyFilter = "O"
Me.CompanyPhoneList.Requery
Case 16
Me.TxtCompanyFilter = "P"
Me.CompanyPhoneList.Requery
Case 17
Me.TxtCompanyFilter = "Q"
Me.CompanyPhoneList.Requery
Case 18
Me.TxtCompanyFilter = "R"
Me.CompanyPhoneList.Requery
Case 19
Me.TxtCompanyFilter = "S"
Me.CompanyPhoneList.Requery
Case 20
Me.TxtCompanyFilter = "T"
Me.CompanyPhoneList.Requery
Case 21
Me.TxtCompanyFilter = "U"
Me.CompanyPhoneList.Requery
Case 22
Me.TxtCompanyFilter = "V"
Me.CompanyPhoneList.Requery
Case 23
Me.TxtCompanyFilter = "W"
Me.CompanyPhoneList.Requery
Case 24
Me.TxtCompanyFilter = "X"
Me.CompanyPhoneList.Requery
Case 25
Me.TxtCompanyFilter = "Y"
Me.CompanyPhoneList.Requery
Case 26
Me.TxtCompanyFilter = "Z"
Me.CompanyPhoneList.Requery
Case 27
Me.TxtCompanyFilter = "*"
Me.CompanyPhoneList.Requery
Case 28
Me.TxtCompanyFilter = "#"
Me.CompanyPhoneList.Requery

End Select
Me.RecordSource = "Select * FROM Tbl_Company WHERE
CompanyName Like """ & TxtCompanyFilter & "*"""
Me.Requery


End Sub


Private Sub FrmClose_Click()
DoCmd.Close
End Sub

Private Sub FrmDelete_Click()
DoCmd.OpenForm "Frm_Company_Main", , , "[CompanyID]=" &
Me![CompanyPhoneList].Column(0)
Forms!Frm_Company_Main.Caption = "Delete Company"
Forms!Frm_Company_Main.FrmDelete.Enabled = True
Forms!Frm_Company_Main.FrmAdd.Enabled = False
End Sub

Private Sub FrmAdd_Click()
DoCmd.OpenForm "Frm_Company_Main", dataMode:=acFormAdd
Forms!Frm_Company_Main.Caption = "ADD Company"
Forms!Frm_Company_Main.CancelNew.Enabled = True
End Sub



'Purpose: This module illustrates how to create a search form, _
where the user can enter as many or few criteria as they
wish, _
and results are shown one per line.
'Note: Only records matching ALL of the criteria are returned.


Private Sub cmdFilter_Click()
'Purpose: Build up the criteria string form the non-blank search
boxes, and apply to the form's Filter.
'Notes: 1. We tack " AND " on the end of each condition so you
can easily add more search boxes; _
we remove the trailing " AND " at the end.
' 2. The date range works like this: _
Both dates = only dates between (both
inclusive. _
Start date only = all dates from this one
onwards; _
End date only = all dates up to (and
including this one).
Dim strWhere As String 'The criteria string.
Dim lngLen As Long 'Length of the criteria
string to append to.
Const conJetDate = "\#mm\/dd\/yyyy\#" 'The format expected for
dates in a JET query string.


'***********************************************************************
'Look at each search box, and build up the criteria string from the
non-blank ones.

'***********************************************************************

'Another text field example. Use Like to find anywhere in the
field.
If Not IsNull(Me.TxtFilterCompanyName) Then
strWhere = strWhere & "([CompanyName] Like ""*" &
Me.TxtFilterCompanyName & "*"") AND "
End If


'Another text field example. Use Like to find anywhere in the
field.
If Not IsNull(Me.TxtFilterPhone) Then
strWhere = strWhere & "([Phone] Like ""*" & Me.TxtFilterPhone &
"*"") AND "
End If

'Number field example. Do not add the extra quotes.
If Not IsNull(Me.CboFilterCompanyType) Then
strWhere = strWhere & "(CompanyType = " &
Me.CboFilterCompanyType & ") AND "
End If

'Number field example. Do not add the extra quotes.
If Not IsNull(Me.CboFilterPrimaryTrade) Then
strWhere = strWhere & "(PrimaryTrade = " &
Me.CboFilterPrimaryTrade & ") AND "

End If
'Number field example. Do not add the extra quotes.
If Not IsNull(Me.CboFilterStatus) Then
strWhere = strWhere & "(Status = " & Me.CboFilterStatus & ")
AND "

End If

'Number field example. Do not add the extra quotes.
If Not IsNull(Me.CboFilterWorkArea) Then
strWhere = strWhere & "(WorkArea = " & Me.CboFilterWorkArea &
") AND "

End If

'Number field example. Do not add the extra quotes.
If Not IsNull(Me.CboFilterState) Then
strWhere = strWhere & "(State = " & Me.CboFilterState & ") AND
"

End If




'***********************************************************************
'Chop off the trailing " AND ", and use the string as the form's
Filter.

'***********************************************************************
'See if the string has more than 5 characters (a trailng " AND ")
to remove.
lngLen = Len(strWhere) - 5
If lngLen <= 0 Then 'Nah: there was nothing in the string.
MsgBox "No criteria", vbInformation, "Nothing to do."
Else 'Yep: there is something there, so remove
the " AND " at the end.
strWhere = Left$(strWhere, lngLen)
'For debugging, remove the leading quote on the next line.
Prints to Immediate Window (Ctrl+G).
'Debug.Print strWhere

'Finally, apply the string as the form's Filter.
Me.Filter = strWhere
Me.FilterOn = True
End If

End Sub

Private Sub cmdReset_Click()
'Purpose: Clear all the search boxes in the Form Footer, and show
all records again.
Dim ctl As Control

'Clear all the controls in the Form Footer section.
For Each ctl In Me.Section(acFooter).Controls
Select Case ctl.ControlType
Case acTextBox, acComboBox
ctl.Value = Null
Case acCheckBox
ctl.Value = False
End Select
Next

'Remove the form's filter.
Me.FilterOn = False

End Sub

Private Sub Form_BeforeInsert(Cancel As Integer)
'To avoid problems if the filter returns no records, we did not set
its AllowAdditions to No.
'We prevent new records by cancelling the form's BeforeInsert event
instead.
'The problems are explained at http://allenbrowne.com/bug-06.html
Cancel = True
MsgBox "You cannot add new clients to the search form.",
vbInformation, "Permission denied."
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top