Multi-Select List Box Code Not Quite Working

[PaulDixie]

Hi All,

I'm trying to use a multi-select list box to determine the items in view on my form.

Selecting 1 Item Works!
Seclecting 2+ Items Doesn't Work - but there is no ERROR - each of my text boxes which show update, stay blank. The strange thing is that if I run the code and hover my curser over the string, it shows both items.

Have you seen this before, or could someone evaluate my code below - this (WHERE [strTeamName] = '" & strWhere & "' ) is the code that ultimately should populate my testboxes - ignore the ( and ) above. Code Below:

Dim strWhere As String
Dim ctl As Control
Dim varItem As Variant

'make sure a selection has been made
If Me.List355.ItemsSelected.Count = 0 Then
Exit Sub
End If

'add selected values to string
Set ctl = Me.List355
For Each varItem In ctl.ItemsSelected
strWhere = strWhere & ctl.ItemData(varItem) & ","
'Use this line if your value is text
'strWhere = strWhere & "'" & ctl.ItemData(varItem) & "',"
Next varItem
'trim trailing comma
strWhere = Left(strWhere, Len(strWhere) - 1)

' - - - - - -

Set db = CurrentDb

strSql = "SELECT Q1.strFullName, Q1.DetailsGeneral, Q1.strEmployeeLeft, Q1.strTeamName, Q1.DateBooked "
strSql = strSql & "FROM qry003CalenderLookupA AS Q1 "
strSql = strSql & "WHERE [strTeamName] = '" & strWhere & "' AND [strEmployeeLeft] = False AND (DateBooked Between " & lngFirstOfMonth & " And " & lngLastOfMonth & ") ORDER BY "
strSql = strSql & "DateBooked;"

Set rstEvents = db.OpenRecordset(strSql)


ANY IDEAS?






This is my code:

 

[Norie]

Are you trying to set the criteria for multiple teams?

If you are you need the IN operator, here's the general syntax

[fieldname] IN (list of values)

I think this is how your 2nd line should look.

strSql = strSql & "WHERE [strTeamName] IN (" & strWhere & ") AND [strEmployeeLeft] = False

 

[PaulDixie]

Thanks Norie. I've updated the code and it now gives me a Syntax Error (3075) - do you know where the issue would be?
Your right - I'm trying to set criteria for multiple teams:

Run-Time error '3075':

Syntax error (missing operator) in query expression '[strName] IN (Collateral, Trade Management) AND [strEmployeeLeft] = False AND [DateBooked Between 41214 And 41243)'. - (the collateral and trade management part is the two teams im selecting).

 

[Norie]

The teams are text?

So shouldn't you heed this comment?

'Use this line if your value is text
 'strWhere = strWhere & "'" & ctl.ItemData(varItem) & "',"

 

[PaulDixie]

Thanks Norie - Sorry I can't get this right! The code doesn't give a runtime error, but still nothing populating in my text boxes.
Here is the code and I have highlighted where it skips - not sure why - can you help - im almost there i think!

|||- - - - - Code - - - - - -|||

Dim strWhere As String
Dim ctl As Control
Dim varItem As Variant
'make sure a selection has been made

If Me.List355.ItemsSelected.Count = 0 Then

Exit Sub
End If
Msgbox "a"

'add selected values to string
Set ctl = Me.List355
For Each varItem In ctl.ItemsSelected
'Use this line if your value is text
strWhere = strWhere & "'" & ctl.ItemData(varItem) & "',"
Next varItem
'trim trailing comma
strWhere = Left(strWhere, Len(strWhere) - 1)

' - - - - - -

Set db = CurrentDb

strSql = "SELECT Q1.strFullName, Q1.DetailsGeneral, Q1.strEmployeeLeft, Q1.strTeamName, Q1.DateBooked "
strSql = strSql & "FROM qry003CalenderLookupA AS Q1 "
strSql = strSql & "WHERE [strTeamName] IN(" & strWhere & ") AND [strEmployeeLeft] = False AND (DateBooked Between " & lngFirstOfMonth & " And " & lngLastOfMonth & ") ORDER BY "
strSql = strSql & "DateBooked;"

Set rstEvents = db.OpenRecordset(strSql)

' It now needs to work through the next paragraph of code, but skips the 'Do While Not rstEvents.EOF and moves onto For byBlockCounter (highlighted with *)

Do While Not rstEvents.EOF
strEvent = rstEvents!strFullName & " - " & rstEvents!DetailsGeneral
bytEventDayOfMonth = (rstEvents!DateBooked - lngLastOfPreviousMonth)
bytBlockCounter = bytEventDayOfMonth + bytBlankBlocksBefore
If astrCalendarBlocks(bytBlockCounter) <> "" Then
astrCalendarBlocks(bytBlockCounter) = _
astrCalendarBlocks(bytBlockCounter) & vbNewLine & strEvent
Else
astrCalendarBlocks(bytBlockCounter) = strEvent
End If
rstEvents.MoveNext
Loop

*For bytBlockCounter = 1 To 42 'blank blocks at start of month*
Select Case bytBlockCounter
Case Is < bytFirstWeekdayOfMonth
astrCalendarBlocks(bytBlockCounter) = ""
ReferenceABlock ctlDayBlock, bytBlockCounter
ctlDayBlock.BackColor = 12632256
ctlDayBlock = ""
ctlDayBlock.Enabled = True
ctlDayBlock.Tag = ""
Case Is > bytBlankBlocksBefore + bytDaysInMonth 'blank blocks at end of month
astrCalendarBlocks(bytBlockCounter) = ""
ReferenceABlock ctlDayBlock, bytBlockCounter
ctlDayBlock.BackColor = 12632256
ctlDayBlock = ""
ctlDayBlock.Enabled = False
ctlDayBlock.Tag = ""
If bytBlankBlocksAfter > 6 And bytBlockCounter > 42 Then
ctlDayBlock.Visible = False
End If
Case Else 'blocks that hold days of the month
bytBlockDayOfMonth = bytBlockCounter - bytBlankBlocksBefore
ReferenceABlock ctlDayBlock, bytBlockCounter
lngBlockDate = lngLastOfPreviousMonth + bytBlockDayOfMonth 'block's date
If bytBlockDayOfMonth < 10 Then
ctlDayBlock = Space(2) & bytBlockDayOfMonth & _
vbNewLine & astrCalendarBlocks(bytBlockCounter)
Else
ctlDayBlock = bytBlockDayOfMonth & _
vbNewLine & astrCalendarBlocks(bytBlockCounter)
End If

'If this block is the system date, change its color
If lngBlockDate = lngSystemDate Then
ctlDayBlock.BackColor = QBColor(2)
ctlDayBlock.ForeColor = QBColor(15)
Set ctlSystemDateBlock = ctlDayBlock
blnSystemDateIsShown = True
Else
ctlDayBlock.BackColor = 16777215
ctlDayBlock.ForeColor = 0
End If
ctlDayBlock.Visible = True
ctlDayBlock.Enabled = True
ctlDayBlock.Tag = lngBlockDate
End Select


Next
'If the system date is in this month, show its events
If blnSystemDateIsShown Then
PopulateEventsList ctlSystemDateBlock
End If


Call PopulateYearListBox

|||- - - - - Code - - - - - -|||

 

[PaulDixie]

It's OK - It Works! I couldn't see anything else wrong with the code - I came out of the form and back in and it's fine! Thanks for all your help!