Filter a continuous form using multi-select list box

N

Nick W

Hi All,

I have a continous form where the users can filter the records using
text and combo boxes - see code below:

Private Sub CmdFilter_Click()
Dim strWhere As String
Dim lngLen As Long
Const conJetDate = "\#mm\/dd\/yyyy\#"

If Not IsNull(Me.Combo0) Then
strWhere = strWhere & "([Directorate] = """ & Me.Combo0 & """)
AND "
End If

If Not IsNull(Me.Combo112) Then
strWhere = strWhere & "([SuccessfulChosen] = """ & Me.Combo112
& """) AND "
End If

If Not IsNull(Me.Combo12) Then
strWhere = strWhere & "([FTE] = """ & Me.Combo12 & """) AND "
End If

If Not IsNull(Me.Combo14) Then
strWhere = strWhere & "([EmploymentStatus] = """ & Me.Combo14
& """) AND "
End If

If Not IsNull(Me.Combo16) Then
strWhere = strWhere & "([JobLocation] = """ & Me.Combo16 &
""") AND "
End If

If Not IsNull(Me.Combo18) Then
strWhere = strWhere & "([ManagerDetails] = """ & Me.Combo18 &
""") AND "
End If

If Not IsNull(Me.Combo24) Then
strWhere = strWhere & "([Section] = """ & Me.Combo24 & """)
AND "
End If

If Not IsNull(Me.Combo26) Then
strWhere = strWhere & "([RecruitmentContactID] = " &
Me.Combo26 & ") AND "
End If

If Not IsNull(Me.Combo92) Then
strWhere = strWhere & "([JobStatusID] = " & Me.Combo92 & ")
AND "
End If

If Not IsNull(Me.Combo32) Then
strWhere = strWhere & "([Internal/ExternalID] = " & Me.Combo32
& ") AND "
End If

If Not IsNull(Me.Combo30) Then
strWhere = strWhere & "([ReasonForJobID] = " & Me.Combo30 & ")
AND "
End If

If Not IsNull(Me.Combo22) Then
strWhere = strWhere & "([TblJobSkillset].[SkillsetCategoryID]
= " & Me.Combo22 & ") AND "
End If

If Not IsNull(Me.Text2) Then
strWhere = strWhere & "([RAFApprovalDate] >= " &
Format(Me.Text2, conJetDate) & ") AND "
End If

If Not IsNull(Me.Text4) Then
strWhere = strWhere & "([RAFApprovalDate] < " &
Format(Me.Text4 + 1, conJetDate) & ") AND "
End If

If Not IsNull(Me.Text128) Then
strWhere = strWhere & "([QryAllClosingDates].[ClosingDate] >=
" & Format(Me.Text128, conJetDate) & ") AND "
End If

If Not IsNull(Me.Text130) Then
strWhere = strWhere & "([QryAllClosingDates].[ClosingDate] < "
& Format(Me.Text130 + 1, conJetDate) & ") AND "
End If


If Not IsNull(Me.Text6) Then
strWhere = strWhere & "([Expiry Date] >= " & Format(Me.Text6,
conJetDate) & ") AND "
End If

If Not IsNull(Me.Text8) Then
strWhere = strWhere & "([Expiry Date] < " & Format(Me.Text8 +
1, conJetDate) & ") AND "
End If

lngLen = Len(strWhere) - 5
If lngLen <= 0 Then
MsgBox "No criteria", vbInformation, "Nothing to do."
Else
strWhere = Left$(strWhere, lngLen)
Debug.Print strWhere

Me.Filter = strWhere
Me.FilterOn = True
End If
End Sub

Private Sub cmdReset_Click()

Dim ctl As Control

For Each ctl In Me.Section(acHeader).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.Filter = "(False)"
'Me.FilterOn = True

End Sub

However the users would like to be able to select more than one item
from some of the combo boxes, I assume to be able to do this I would
need to replace those combo boxes with list boxes however I'm unsure
whether this is possible, if so how do I go about doing it, and if not
can anyone offer an alternative solution?

Thanks in advance
Nick
 
D

Douglas J. Steele

Yes, to allow more than one choice, you'd need to replace the combo box with
a list box that has its MultiSelect property set to other than None.

Assuming you replaced Combo0 with List0 to allow them to select multiple
Directorates, you'd use code like:

Dim strSelected As Variant
Dim varSelected As Variant

If Me.List0.ItemsSelected.Count > 0 Then
For Each varSelected In Me.List0.ItemsSelected
strSelected = strSelected & """" & _
Me.List0.ItemData(varSelected) & """, "
Next varSelected
strWhere = strWhere & "([Directorate] IN (" & _
Left$(strSelected, Len(strSelected) - 2) & ")) AND "
End If


--
Doug Steele, Microsoft Access MVP

(no e-mails, please!)


Nick W said:
Hi All,

I have a continous form where the users can filter the records using
text and combo boxes - see code below:

Private Sub CmdFilter_Click()
Dim strWhere As String
Dim lngLen As Long
Const conJetDate = "\#mm\/dd\/yyyy\#"

If Not IsNull(Me.Combo0) Then
strWhere = strWhere & "([Directorate] = """ & Me.Combo0 & """)
AND "
End If

If Not IsNull(Me.Combo112) Then
strWhere = strWhere & "([SuccessfulChosen] = """ & Me.Combo112
& """) AND "
End If

If Not IsNull(Me.Combo12) Then
strWhere = strWhere & "([FTE] = """ & Me.Combo12 & """) AND "
End If

If Not IsNull(Me.Combo14) Then
strWhere = strWhere & "([EmploymentStatus] = """ & Me.Combo14
& """) AND "
End If

If Not IsNull(Me.Combo16) Then
strWhere = strWhere & "([JobLocation] = """ & Me.Combo16 &
""") AND "
End If

If Not IsNull(Me.Combo18) Then
strWhere = strWhere & "([ManagerDetails] = """ & Me.Combo18 &
""") AND "
End If

If Not IsNull(Me.Combo24) Then
strWhere = strWhere & "([Section] = """ & Me.Combo24 & """)
AND "
End If

If Not IsNull(Me.Combo26) Then
strWhere = strWhere & "([RecruitmentContactID] = " &
Me.Combo26 & ") AND "
End If

If Not IsNull(Me.Combo92) Then
strWhere = strWhere & "([JobStatusID] = " & Me.Combo92 & ")
AND "
End If

If Not IsNull(Me.Combo32) Then
strWhere = strWhere & "([Internal/ExternalID] = " & Me.Combo32
& ") AND "
End If

If Not IsNull(Me.Combo30) Then
strWhere = strWhere & "([ReasonForJobID] = " & Me.Combo30 & ")
AND "
End If

If Not IsNull(Me.Combo22) Then
strWhere = strWhere & "([TblJobSkillset].[SkillsetCategoryID]
= " & Me.Combo22 & ") AND "
End If

If Not IsNull(Me.Text2) Then
strWhere = strWhere & "([RAFApprovalDate] >= " &
Format(Me.Text2, conJetDate) & ") AND "
End If

If Not IsNull(Me.Text4) Then
strWhere = strWhere & "([RAFApprovalDate] < " &
Format(Me.Text4 + 1, conJetDate) & ") AND "
End If

If Not IsNull(Me.Text128) Then
strWhere = strWhere & "([QryAllClosingDates].[ClosingDate] >=
" & Format(Me.Text128, conJetDate) & ") AND "
End If

If Not IsNull(Me.Text130) Then
strWhere = strWhere & "([QryAllClosingDates].[ClosingDate] < "
& Format(Me.Text130 + 1, conJetDate) & ") AND "
End If


If Not IsNull(Me.Text6) Then
strWhere = strWhere & "([Expiry Date] >= " & Format(Me.Text6,
conJetDate) & ") AND "
End If

If Not IsNull(Me.Text8) Then
strWhere = strWhere & "([Expiry Date] < " & Format(Me.Text8 +
1, conJetDate) & ") AND "
End If

lngLen = Len(strWhere) - 5
If lngLen <= 0 Then
MsgBox "No criteria", vbInformation, "Nothing to do."
Else
strWhere = Left$(strWhere, lngLen)
Debug.Print strWhere

Me.Filter = strWhere
Me.FilterOn = True
End If
End Sub

Private Sub cmdReset_Click()

Dim ctl As Control

For Each ctl In Me.Section(acHeader).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.Filter = "(False)"
'Me.FilterOn = True

End Sub

However the users would like to be able to select more than one item
from some of the combo boxes, I assume to be able to do this I would
need to replace those combo boxes with list boxes however I'm unsure
whether this is possible, if so how do I go about doing it, and if not
can anyone offer an alternative solution?

Thanks in advance
Nick
Click to expand...
 
N

Nick W

Thanks a lot for your help and your quick response

I've used the code but when I filter the form all records disappear,
I've tried selecting one item from the list box and then a couple and
it happens both times. Is there something obvious I'd doing wrong that
you'd know of?

Here's the code now I've amended it, I swapped combo22 for List145,
the list box looks up the values from tblJobSkillset that lists the 9
skillsets by reference with their descriptions. I've set the multi
select to Simple and the bound column is 1 which will be the
description - SkillsetCategory

SkillsetCategoryID SkillsetCategory

1 Prof Engineering / Op Mgrs
2 Telemetry / Telecontrol
3 Project / Contract Management
4 IT Specialist
5 Professional Support
6 Scientific / Analytical
7 Admin / Tech
8 Craft / Controllers
9 Semi Skilled Craft
10 Manual
11 Exec Manager Band C
12 Sen Manager Band D


Code:

Private Sub CmdFilter_Click()
Dim strWhere As String
Dim lngLen As Long
Const conJetDate = "\#mm\/dd\/yyyy\#"
Dim strSelected As Variant
Dim varSelected As Variant

If Me.List145.ItemsSelected.Count > 0 Then
For Each varSelected In Me.List145.ItemsSelected
strSelected = strSelected & """" & _
Me.List145.ItemData(varSelected) & """, "
Next varSelected
strWhere = strWhere & "([SkillsetCategory] IN (" & _
Left$(strSelected, Len(strSelected) - 2) & ")) AND "
End If

If Not IsNull(Me.Combo0) Then
strWhere = strWhere & "([Directorate] = """ & Me.Combo0 & """)
AND "
End If

If Not IsNull(Me.Combo112) Then
strWhere = strWhere & "([SuccessfulChosen] = """ & Me.Combo112
& """) AND "
End If

If Not IsNull(Me.Combo12) Then
strWhere = strWhere & "([FTE] = """ & Me.Combo12 & """) AND "
End If

If Not IsNull(Me.Combo14) Then
strWhere = strWhere & "([EmploymentStatus] = """ & Me.Combo14
& """) AND "
End If

If Not IsNull(Me.Combo16) Then
strWhere = strWhere & "([JobLocation] = """ & Me.Combo16 &
""") AND "
End If

If Not IsNull(Me.Combo18) Then
strWhere = strWhere & "([ManagerDetails] = """ & Me.Combo18 &
""") AND "
End If

If Not IsNull(Me.Combo24) Then
strWhere = strWhere & "([Section] = """ & Me.Combo24 & """)
AND "
End If

If Not IsNull(Me.Combo26) Then
strWhere = strWhere & "([RecruitmentContactID] = " &
Me.Combo26 & ") AND "
End If

If Not IsNull(Me.Combo92) Then
strWhere = strWhere & "([JobStatusID] = " & Me.Combo92 & ")
AND "
End If

If Not IsNull(Me.Combo32) Then
strWhere = strWhere & "([Internal/ExternalID] = " & Me.Combo32
& ") AND "
End If

If Not IsNull(Me.Combo30) Then
strWhere = strWhere & "([ReasonForJobID] = " & Me.Combo30 & ")
AND "
End If

If Not IsNull(Me.Text2) Then
strWhere = strWhere & "([RAFApprovalDate] >= " &
Format(Me.Text2, conJetDate) & ") AND "
End If

If Not IsNull(Me.Text4) Then
strWhere = strWhere & "([RAFApprovalDate] < " &
Format(Me.Text4 + 1, conJetDate) & ") AND "
End If

If Not IsNull(Me.Text128) Then
strWhere = strWhere & "([QryAllClosingDates].[ClosingDate] >=
" & Format(Me.Text128, conJetDate) & ") AND "
End If

If Not IsNull(Me.Text130) Then
strWhere = strWhere & "([QryAllClosingDates].[ClosingDate] < "
& Format(Me.Text130 + 1, conJetDate) & ") AND "
End If


If Not IsNull(Me.Text6) Then
strWhere = strWhere & "([Expiry Date] >= " & Format(Me.Text6,
conJetDate) & ") AND "
End If

If Not IsNull(Me.Text8) Then
strWhere = strWhere & "([Expiry Date] < " & Format(Me.Text8 +
1, conJetDate) & ") AND "
End If

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

Can you spot where I'm going wrong, I'm sure it's something daft,

Thanks
Nick
 
D

Douglas J. Steele

What's actually stored in [SkillsetCategor]: the number or the text? (I
would hope it's the number...)

If it's a number, you don't want the extra quotes in there.

By the way, if you want to return a different column from the list box than
the bound one, you can use its Column collection. For example, to get the
value of the 1st column if it isn't the bound column, you'd use

For Each varSelected In Me.List145.ItemsSelected
strSelected = strSelected & _
Me.List145.Column(0, varSelected) & ", "
Next varSelected

(the Column collection starts numbering at 0)

If that doesn't solve your problem, show me what's stored in strWhere when
it's failing.

--
Doug Steele, Microsoft Access MVP

(no e-mails, please!)


Nick W said:
Thanks a lot for your help and your quick response

I've used the code but when I filter the form all records disappear,
I've tried selecting one item from the list box and then a couple and
it happens both times. Is there something obvious I'd doing wrong that
you'd know of?

Here's the code now I've amended it, I swapped combo22 for List145,
the list box looks up the values from tblJobSkillset that lists the 9
skillsets by reference with their descriptions. I've set the multi
select to Simple and the bound column is 1 which will be the
description - SkillsetCategory

SkillsetCategoryID SkillsetCategory

1 Prof Engineering / Op Mgrs
2 Telemetry / Telecontrol
3 Project / Contract Management
4 IT Specialist
5 Professional Support
6 Scientific / Analytical
7 Admin / Tech
8 Craft / Controllers
9 Semi Skilled Craft
10 Manual
11 Exec Manager Band C
12 Sen Manager Band D


Code:

Private Sub CmdFilter_Click()
Dim strWhere As String
Dim lngLen As Long
Const conJetDate = "\#mm\/dd\/yyyy\#"
Dim strSelected As Variant
Dim varSelected As Variant

If Me.List145.ItemsSelected.Count > 0 Then
For Each varSelected In Me.List145.ItemsSelected
strSelected = strSelected & """" & _
Me.List145.ItemData(varSelected) & """, "
Next varSelected
strWhere = strWhere & "([SkillsetCategory] IN (" & _
Left$(strSelected, Len(strSelected) - 2) & ")) AND "
End If

If Not IsNull(Me.Combo0) Then
strWhere = strWhere & "([Directorate] = """ & Me.Combo0 & """)
AND "
End If

If Not IsNull(Me.Combo112) Then
strWhere = strWhere & "([SuccessfulChosen] = """ & Me.Combo112
& """) AND "
End If

If Not IsNull(Me.Combo12) Then
strWhere = strWhere & "([FTE] = """ & Me.Combo12 & """) AND "
End If

If Not IsNull(Me.Combo14) Then
strWhere = strWhere & "([EmploymentStatus] = """ & Me.Combo14
& """) AND "
End If

If Not IsNull(Me.Combo16) Then
strWhere = strWhere & "([JobLocation] = """ & Me.Combo16 &
""") AND "
End If

If Not IsNull(Me.Combo18) Then
strWhere = strWhere & "([ManagerDetails] = """ & Me.Combo18 &
""") AND "
End If

If Not IsNull(Me.Combo24) Then
strWhere = strWhere & "([Section] = """ & Me.Combo24 & """)
AND "
End If

If Not IsNull(Me.Combo26) Then
strWhere = strWhere & "([RecruitmentContactID] = " &
Me.Combo26 & ") AND "
End If

If Not IsNull(Me.Combo92) Then
strWhere = strWhere & "([JobStatusID] = " & Me.Combo92 & ")
AND "
End If

If Not IsNull(Me.Combo32) Then
strWhere = strWhere & "([Internal/ExternalID] = " & Me.Combo32
& ") AND "
End If

If Not IsNull(Me.Combo30) Then
strWhere = strWhere & "([ReasonForJobID] = " & Me.Combo30 & ")
AND "
End If

If Not IsNull(Me.Text2) Then
strWhere = strWhere & "([RAFApprovalDate] >= " &
Format(Me.Text2, conJetDate) & ") AND "
End If

If Not IsNull(Me.Text4) Then
strWhere = strWhere & "([RAFApprovalDate] < " &
Format(Me.Text4 + 1, conJetDate) & ") AND "
End If

If Not IsNull(Me.Text128) Then
strWhere = strWhere & "([QryAllClosingDates].[ClosingDate] >=
" & Format(Me.Text128, conJetDate) & ") AND "
End If

If Not IsNull(Me.Text130) Then
strWhere = strWhere & "([QryAllClosingDates].[ClosingDate] < "
& Format(Me.Text130 + 1, conJetDate) & ") AND "
End If


If Not IsNull(Me.Text6) Then
strWhere = strWhere & "([Expiry Date] >= " & Format(Me.Text6,
conJetDate) & ") AND "
End If

If Not IsNull(Me.Text8) Then
strWhere = strWhere & "([Expiry Date] < " & Format(Me.Text8 +
1, conJetDate) & ") AND "
End If

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

Can you spot where I'm going wrong, I'm sure it's something daft,

Thanks
Nick
Click to expand...
 
N

Nick W

Thanks a lot for your help, I've changed all the combo boxes for list
boxes tested them individually and they all work well. However when I
try and select multiple items in multiple list boxes I get a Run-time
Error 2001, 'You cancelled the previous operation'. Is it possible to
be able to do this? Here's my amended code, can you tell me where I'm
going wrong?

Private Sub CmdFilter_Click()
Dim strWhere As String
Dim lngLen As Long
Const conJetDate = "\#mm\/dd\/yyyy\#"
Dim strSelected As Variant
Dim varSelected As Variant


If Me.List146.ItemsSelected.Count > 0 Then
For Each varSelected In Me.List146.ItemsSelected
strSelected = strSelected & """" & _
Me.List146.ItemData(varSelected) & """, "
Next varSelected
strWhere = strWhere & "([JobLocation] IN (" & _
Left$(strSelected, Len(strSelected) - 2) & ")) AND "
End If

If Me.List148.ItemsSelected.Count > 0 Then
For Each varSelected In Me.List148.ItemsSelected
strSelected = strSelected & """" & _
Me.List148.ItemData(varSelected) & """, "
Next varSelected
strWhere = strWhere & "([Directorate] IN (" & _
Left$(strSelected, Len(strSelected) - 2) & ")) AND "
End If

If Me.List154.ItemsSelected.Count > 0 Then
For Each varSelected In Me.List154.ItemsSelected
strSelected = strSelected & """" & _
Me.List154.ItemData(varSelected) & """, "
Next varSelected
strWhere = strWhere & "([ManagerDetails] IN (" & _
Left$(strSelected, Len(strSelected) - 2) & ")) AND "
End If

If Me.List156.ItemsSelected.Count > 0 Then
For Each varSelected In Me.List156.ItemsSelected
strSelected = strSelected & """" & _
Me.List156.ItemData(varSelected) & """, "
Next varSelected
strWhere = strWhere & "([Section] IN (" & _
Left$(strSelected, Len(strSelected) - 2) & ")) AND "
End If

If Me.List158.ItemsSelected.Count > 0 Then
For Each varSelected In Me.List158.ItemsSelected
strSelected = strSelected & """" & _
Me.List158.ItemData(varSelected) & """, "
Next varSelected
strWhere = strWhere & "([InternalExternalID] IN (" & _
Left$(strSelected, Len(strSelected) - 2) & ")) AND "
End If

If Me.List160.ItemsSelected.Count > 0 Then
For Each varSelected In Me.List160.ItemsSelected
strSelected = strSelected & "" & _
Me.List160.ItemData(varSelected) & ", "
Next varSelected
strWhere = strWhere & "([JobStatusID] IN (" & _
Left$(strSelected, Len(strSelected) - 2) & ")) AND "
End If

If Me.List162.ItemsSelected.Count > 0 Then
For Each varSelected In Me.List162.ItemsSelected
strSelected = strSelected & "" & _
Me.List162.ItemData(varSelected) & ", "
Next varSelected
strWhere = strWhere & "([RecruitmentContactID] IN (" & _
Left$(strSelected, Len(strSelected) - 2) & ")) AND "
End If

If Me.List164.ItemsSelected.Count > 0 Then
For Each varSelected In Me.List164.ItemsSelected
strSelected = strSelected & "" & _
Me.List164.ItemData(varSelected) & ", "
Next varSelected
strWhere = strWhere & "([ReasonForJobID] IN (" & _
Left$(strSelected, Len(strSelected) - 2) & ")) AND "
End If

If Me.List166.ItemsSelected.Count > 0 Then
For Each varSelected In Me.List166.ItemsSelected
strSelected = strSelected & "" & _
Me.List166.ItemData(varSelected) & ", "
Next varSelected
strWhere = strWhere & "([TblJobSkillset.SkillsetCategoryID] IN ("
& _
Left$(strSelected, Len(strSelected) - 2) & ")) AND "
End If

If Not IsNull(Me.Combo112) Then
strWhere = strWhere & "([SuccessfulChosen] = """ & Me.Combo112
& """) AND "
End If

If Not IsNull(Me.Combo12) Then
strWhere = strWhere & "([FTE] = """ & Me.Combo12 & """) AND "
End If

If Not IsNull(Me.Combo14) Then
strWhere = strWhere & "([EmploymentStatus] = """ & Me.Combo14
& """) AND "
End If

If Not IsNull(Me.Text2) Then
strWhere = strWhere & "([RAFApprovalDate] >= " &
Format(Me.Text2, conJetDate) & ") AND "
End If

If Not IsNull(Me.Text4) Then
strWhere = strWhere & "([RAFApprovalDate] < " &
Format(Me.Text4 + 1, conJetDate) & ") AND "
End If

If Not IsNull(Me.Text128) Then
strWhere = strWhere & "([QryAllClosingDates].[ClosingDate] >=
" & Format(Me.Text128, conJetDate) & ") AND "
End If

If Not IsNull(Me.Text130) Then
strWhere = strWhere & "([QryAllClosingDates].[ClosingDate] < "
& Format(Me.Text130 + 1, conJetDate) & ") AND "
End If


If Not IsNull(Me.Text6) Then
strWhere = strWhere & "([Expiry Date] >= " & Format(Me.Text6,
conJetDate) & ") AND "
End If

If Not IsNull(Me.Text8) Then
strWhere = strWhere & "([Expiry Date] < " & Format(Me.Text8 +
1, conJetDate) & ") AND "
End If

lngLen = Len(strWhere) - 5
If lngLen <= 0 Then
MsgBox "No criteria", vbInformation, "Nothing to do."
Else
strWhere = Left$(strWhere, lngLen)
'For debugging, remove the leading quote on the next line.
Prints to Immediate Window (Ctrl+G).
Debug.Print strWhere

Me.Filter = strWhere
Me.FilterOn = True
End If
End Sub

Thanks again for your help,

Nick
 
D

Douglas J. Steele

Double-check the names of all of the fields you're using: that misleading
message sometimes means you've got an incorrect name in there.

--
Doug Steele, Microsoft Access MVP

(no e-mails, please!)


Nick W said:
Thanks a lot for your help, I've changed all the combo boxes for list
boxes tested them individually and they all work well. However when I
try and select multiple items in multiple list boxes I get a Run-time
Error 2001, 'You cancelled the previous operation'. Is it possible to
be able to do this? Here's my amended code, can you tell me where I'm
going wrong?

Private Sub CmdFilter_Click()
Dim strWhere As String
Dim lngLen As Long
Const conJetDate = "\#mm\/dd\/yyyy\#"
Dim strSelected As Variant
Dim varSelected As Variant


If Me.List146.ItemsSelected.Count > 0 Then
For Each varSelected In Me.List146.ItemsSelected
strSelected = strSelected & """" & _
Me.List146.ItemData(varSelected) & """, "
Next varSelected
strWhere = strWhere & "([JobLocation] IN (" & _
Left$(strSelected, Len(strSelected) - 2) & ")) AND "
End If

If Me.List148.ItemsSelected.Count > 0 Then
For Each varSelected In Me.List148.ItemsSelected
strSelected = strSelected & """" & _
Me.List148.ItemData(varSelected) & """, "
Next varSelected
strWhere = strWhere & "([Directorate] IN (" & _
Left$(strSelected, Len(strSelected) - 2) & ")) AND "
End If

If Me.List154.ItemsSelected.Count > 0 Then
For Each varSelected In Me.List154.ItemsSelected
strSelected = strSelected & """" & _
Me.List154.ItemData(varSelected) & """, "
Next varSelected
strWhere = strWhere & "([ManagerDetails] IN (" & _
Left$(strSelected, Len(strSelected) - 2) & ")) AND "
End If

If Me.List156.ItemsSelected.Count > 0 Then
For Each varSelected In Me.List156.ItemsSelected
strSelected = strSelected & """" & _
Me.List156.ItemData(varSelected) & """, "
Next varSelected
strWhere = strWhere & "([Section] IN (" & _
Left$(strSelected, Len(strSelected) - 2) & ")) AND "
End If

If Me.List158.ItemsSelected.Count > 0 Then
For Each varSelected In Me.List158.ItemsSelected
strSelected = strSelected & """" & _
Me.List158.ItemData(varSelected) & """, "
Next varSelected
strWhere = strWhere & "([InternalExternalID] IN (" & _
Left$(strSelected, Len(strSelected) - 2) & ")) AND "
End If

If Me.List160.ItemsSelected.Count > 0 Then
For Each varSelected In Me.List160.ItemsSelected
strSelected = strSelected & "" & _
Me.List160.ItemData(varSelected) & ", "
Next varSelected
strWhere = strWhere & "([JobStatusID] IN (" & _
Left$(strSelected, Len(strSelected) - 2) & ")) AND "
End If

If Me.List162.ItemsSelected.Count > 0 Then
For Each varSelected In Me.List162.ItemsSelected
strSelected = strSelected & "" & _
Me.List162.ItemData(varSelected) & ", "
Next varSelected
strWhere = strWhere & "([RecruitmentContactID] IN (" & _
Left$(strSelected, Len(strSelected) - 2) & ")) AND "
End If

If Me.List164.ItemsSelected.Count > 0 Then
For Each varSelected In Me.List164.ItemsSelected
strSelected = strSelected & "" & _
Me.List164.ItemData(varSelected) & ", "
Next varSelected
strWhere = strWhere & "([ReasonForJobID] IN (" & _
Left$(strSelected, Len(strSelected) - 2) & ")) AND "
End If

If Me.List166.ItemsSelected.Count > 0 Then
For Each varSelected In Me.List166.ItemsSelected
strSelected = strSelected & "" & _
Me.List166.ItemData(varSelected) & ", "
Next varSelected
strWhere = strWhere & "([TblJobSkillset.SkillsetCategoryID] IN ("
& _
Left$(strSelected, Len(strSelected) - 2) & ")) AND "
End If

If Not IsNull(Me.Combo112) Then
strWhere = strWhere & "([SuccessfulChosen] = """ & Me.Combo112
& """) AND "
End If

If Not IsNull(Me.Combo12) Then
strWhere = strWhere & "([FTE] = """ & Me.Combo12 & """) AND "
End If

If Not IsNull(Me.Combo14) Then
strWhere = strWhere & "([EmploymentStatus] = """ & Me.Combo14
& """) AND "
End If

If Not IsNull(Me.Text2) Then
strWhere = strWhere & "([RAFApprovalDate] >= " &
Format(Me.Text2, conJetDate) & ") AND "
End If

If Not IsNull(Me.Text4) Then
strWhere = strWhere & "([RAFApprovalDate] < " &
Format(Me.Text4 + 1, conJetDate) & ") AND "
End If

If Not IsNull(Me.Text128) Then
strWhere = strWhere & "([QryAllClosingDates].[ClosingDate] >=
" & Format(Me.Text128, conJetDate) & ") AND "
End If

If Not IsNull(Me.Text130) Then
strWhere = strWhere & "([QryAllClosingDates].[ClosingDate] < "
& Format(Me.Text130 + 1, conJetDate) & ") AND "
End If


If Not IsNull(Me.Text6) Then
strWhere = strWhere & "([Expiry Date] >= " & Format(Me.Text6,
conJetDate) & ") AND "
End If

If Not IsNull(Me.Text8) Then
strWhere = strWhere & "([Expiry Date] < " & Format(Me.Text8 +
1, conJetDate) & ") AND "
End If

lngLen = Len(strWhere) - 5
If lngLen <= 0 Then
MsgBox "No criteria", vbInformation, "Nothing to do."
Else
strWhere = Left$(strWhere, lngLen)
'For debugging, remove the leading quote on the next line.
Prints to Immediate Window (Ctrl+G).
Debug.Print strWhere

Me.Filter = strWhere
Me.FilterOn = True
End If
End Sub

Thanks again for your help,

Nick
Click to expand...
 
N

Nick W

I've tested all of the controls and they all work individually so I
assume all the field names are correct, I have tried selecting items
in a list box and a combo box and that also works. I only get the
message when I try and select items in two list boxes, and it can be
any two list boxes, I've tried various combinations using all of
them.

Have you any other ideas what might be causing this problem?

Thanks
 
N

Nick W

I've just realised I didn't try all combinations, having just tried
them I've actually found that some of the list boxes do work together,
the ones that are text based work together and the ones that are
numbers based work together but if I were to select items from a
number based control (e.g RecruitmentContactID) and items from a text
based control (e.g. JobLocation) I get the error message.

Does this help, is there a way around it that you know of?
 
N

Nick W

Thanks a lot for your help, I've now resolved the problem, to overcome
the issue with the text based and number based control's conflicting I
setup two new Dim's:

Dim strSelected As Variant2
Dim varSelected As Variant2

and changed the code for the list box controls that were number based
to include the above and left the text based controls as they were, it
seems to have stopped the conflict

Thanks again,
Nick
 

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

Similar Threads

MultiList Select Box Search Form 7
Multiselect List Box 4
Help with a Query running off of VBA 4
Update All Using a Command Button 3
Form filter- numbers rather than text 2
How to Search Multiple Values in a Filter 5
Sorting Allen Browne's Search Form 2
Search working in one form but not another 4

Top