Multiple Mutliselect Listboxes on one form- Access 2003

[accessd]

Do you know a simple way to create 4-5 multiselect listboxes on a single form in ACCESS 2003? (I have some code for 2 listboxes but it is very very long and troublesome.)

[RuralGuy]

Are you talking about dynamically creating the ListBoxes with code?

[accessd]

I am not exactly sure what "dynamically" means in this context. I am trying to insert VB code in Microsoft ACCESS so I can create multiple listboxes in which I can select multiple values from each list. To do this in Access 2003 you need to have a chunk of code.

[RuralGuy]

Do the ListBoxes already exist on your form and you just want to populate them?

[accessd]

I have 4 multiselect list boxes on my form. The values in each listbox are taken from 4 different tables. I tried to pick a field in the 5th table to store the values in (in the Control Source) but the values are not stored. According to my research on the internet and in books, I need some code when the multiselect property is chosen- it doesn't work by itself in Access 2003.

[RuralGuy]

ListBoxes do not "store" values, they display them.

[accessd]

Right... Which is why I need some code to help store the values I select from the listboxes. The code I have found copies the values selected in a listbox into a text box and also stores them in a table. It seems to work but I get a runtime error (6) when I first start to run it. If I press "end" when the window pops up asking me if I want to debug, the program seems to run smoothly, but I'm not sure how long that will last. So I'm looking for cleaner code.

[RuralGuy]

Are you setting the ListBoxes to ValueLists? What is the RowSource and RowSourceType?

[accessd]

The row type is Table/Query. The row source is: SELECT Conditions.ID, Conditions.Conditions FROM Conditions;

[RuralGuy]

So whatever code you are using should be filling up the Conditions table, right?

[accessd]

How can you put code in a table? The Conditions table has a list of values that I want to choose from and an associated primary key.

When I was in the form in design view, I went to View, Code... which opened up the editor and I pasted in some code I found from the internet.

[RuralGuy]

Does the code you found work? How about posting it here in a post so we can see it?

[accessd]

I'm pasting the details & code I found for 1 multiselect listbox here. This works. The trouble comes when I try to extend the code to include 3 more multiselect listboxes.

1. List Box
   ----------------------------------------------------
   Name : NamesList
   Row Source Type : Table/Query
   Row Source : SELECT FirstName FROM Employees
   Multi Select : Extended
   Width : 3.5"
   Height : 0.75"
   
   
   Text Box
   -----------------------
   Name : mySelections
   Width : 3.5"
   Height : 0.25"
   
   Command Button
   ----------------------------------
   Name : testmultiselect
   Caption : Display Selected Items
   Width : 1.375"
   Height : 0.3"
   
   Command Button
   ----------------------
   Name : ClrList
   Caption : Clear List
   Width : 1.375"
   Height : 0.3"
   

• Option Compare Database
• Option Explicit
• Private Sub Form_Current()
• Dim oItem As Variant
• Dim bFound As Boolean
• Dim sTemp As String
• Dim sValue As String
• Dim sChar As String
• Dim iCount As Integer
• Dim iListItemsCount As Integer
• sTemp = Nz(Me!mySelections.Value, " ")
• iListItemsCount = 0
• bFound = False
• iCount = 0
• Call clearListBox
• For iCount = 1 To Len(sTemp) + 1
• sChar = Mid(sTemp, iCount, 1)
• If StrComp(sChar, ",") = 0 Or iCount = Len(sTemp) + 1 Then
• bFound = False
• Do
• If StrComp(Trim(Me!NamesList.ItemData(iListItemsCount )), Trim(sValue)) = 0 Then
• Me!NamesList.Selected(iListItemsCount) = True
• bFound = True
• End If
• iListItemsCount = iListItemsCount + 1
• Loop Until bFound = True Or iListItemsCount = Me!NamesList.ListCount
• sValue = ""
• Else
• sValue = sValue & sChar
• End If
• Next iCount
• End Sub
• Private Sub clearListBox()
• Dim iCount As Integer
• For iCount = 0 To Me!NamesList.ListCount
• Me!NamesList.Selected(iCount) = False
• Next iCount
• End Sub
• Private Sub testmultiselect_Click()
• Dim oItem As Variant
• Dim sTemp As String
• Dim iCount As Integer
• iCount = 0
• If Me!NamesList.ItemsSelected.Count <> 0 Then
• For Each oItem In Me!NamesList.ItemsSelected
• If iCount = 0 Then
• sTemp = sTemp & Me!NamesList.ItemData(oItem)
• iCount = iCount + 1
• Else
• sTemp = sTemp & "," & Me!NamesList.ItemData(oItem)
• iCount = iCount + 1
• End If
• Next oItem
• Else
• MsgBox "Nothing was selected from the list", vbInformation
• Exit Sub 'Nothing was selected
• End If
• Me!mySelections.Value = sTemp
• End Sub
• Private Sub clrList_Click()
• Call clearListBox
• Me!mySelections.Value = Null
• End Sub

______________________
HERE IS MY CODE FOR 4 multiselect listboxes. It gets stuck at:iListItemsCountc = iListItemsCountc + 1but then it starts working again when I end the debugger.**It's Long_________________________

Option Compare Database

Option ExplicitPrivate Sub Form_Current()
Dim oItem As Variant
Dim bFound As Boolean
Dim sTemp As String
Dim sValue As String
Dim sChar As String
Dim iCount As Integer
Dim iListItemsCount As Integer
Dim oItemb As Variant
Dim bFoundb As Boolean
Dim sTempb As String
Dim sValueb As String
Dim sCharb As String
Dim iCountb As Integer
Dim iListItemsCountb As Integer
Dim oItemc As Variant
Dim bFoundc As Boolean
Dim sTempc As String
Dim sValuec As String
Dim sCharc As String
Dim iCountc As Integer
Dim iListItemsCountc As Integer
Dim oItemd As Variant
Dim bFoundd As Boolean
Dim sTempd As String
Dim sValued As String
Dim sChard As String
Dim iCountd As Integer
Dim iListItemsCountd As Integer

sTemp = Nz(Me!MySelections.Value, " ")
iListItemsCount = 0
bFound = False
iCount = 0 sTempb = Nz(Me!MySelectionsB.Value, " ")
iListItemsCountb = 0
bFoundb = False
iCountb = 0
sTempc = Nz(Me!mySelectionsC.Value, " ")
iListItemsCountc = 0
bFoundc = False
iCountc = 0


sTempd = Nz(Me!MySelectionsD.Value, " ")
iListItemsCountd = 0
bFoundd = False
iCountd = 0


Call clearListBox
Call clearListBoxB
Call clearListBoxC
Call clearListBoxD

For iCount = 1 To Len(sTemp) + 1
sChar = Mid(sTemp, iCount, 1)
If StrComp(sChar, ",") = 0 Or iCount = Len(sTemp) + 1 Then
bFound = False
Do
If StrComp(Trim(Me!Diagnoses.ItemData(iListItemsCount )), Trim(sValue)) = 0 Then
Me!Diagnoses.Selected(iListItemsCount) = True
bFound = True
End If
iListItemsCount = iListItemsCount + 1
Loop Until bFound = True Or iListItemsCount = Me!Diagnoses.ListCount
sValue = ""
Else
sValue = sValue & sChar
End If
Next iCount

For iCountb = 1 To Len(sTempb) + 1
sCharb = Mid(sTempb, iCountb, 1)
If StrComp(sCharb, ",") = 0 Or iCountb = Len(sTempb) + 1 Then
bFoundb = False
Do
If StrComp(Trim(Me!Conditions.ItemData(iListItemsCoun tb)), Trim(sValueb)) = 0 Then
Me!Conditions.Selected(iListItemsCountb) = True
bFoundb = True
End If
iListItemsCountb = iListItemsCountb + 1
Loop Until bFoundb = True Or iListItemsCountb = Me!Conditions.ListCount
sValueb = ""
Else
sValueb = sValueb & sCharb
End If
Next iCountb

For iCountc = 1 To Len(sTempc) + 1
sCharc = Mid(sTempc, iCountc, 1)
If StrComp(sCharc, ",") = 0 Or iCountc = Len(sTempc) + 1 Then
bFoundc = False
Do
If StrComp(Trim(Me!Issues.ItemData(iListItemsCountc)) , Trim(sValuec)) = 0 Then
Me!Issues.Selected(iListItemsCountc) = True
bFoundc = True
End If
iListItemsCountc = iListItemsCountc + 1
Loop Until bFoundc = True Or iListItemsCountc = Me!Issues.ListCount
sValuec = ""
Else
sValuec = sValuec & sCharc
End If
Next iCountc

For iCountd = 1 To Len(sTempd) + 1
sChard = Mid(sTempd, iCountd, 1)
If StrComp(sChard, ",") = 0 Or iCountd = Len(sTempd) + 1 Then
bFoundd = False
Do
If StrComp(Trim(Me!Other.ItemData(iListItemsCountd)), Trim(sValued)) = 0 Then
Me!Other.Selected(iListItemsCountd) = True
bFoundd = True
End If
iListItemsCountd = iListItemsCountd + 1
Loop Until bFoundd = True Or iListItemsCountd = Me!Other.ListCount
sValued = ""
Else
sValued = sValued & sChard
End If
Next iCountdEnd Sub

Private Sub testmultiselect_Click()
Dim oItem As Variant
Dim sTemp As String
Dim iCount As Integer

iCount = 0

If Me!Diagnoses.ItemsSelected.Count <> 0 Then
For Each oItem In Me!Diagnoses.ItemsSelected
If iCount = 0 Then
sTemp = sTemp & Me!Diagnoses.ItemData(oItem)
iCount = iCount + 1
Else
sTemp = sTemp & "," & Me!Diagnoses.ItemData(oItem)
iCount = iCount + 1
End If
Next oItem
Else
MsgBox "Nothing was selected from the list", vbInformation
Exit Sub 'Nothing was selected
End If

Me!MySelections.Value = sTemp
End Sub
Private Sub testmultiselectb_Click()
Dim oItem As Variant
Dim sTemp As String
Dim iCount As Integer

iCount = 0

If Me!Conditions.ItemsSelected.Count <> 0 Then
For Each oItem In Me!Conditions.ItemsSelected
If iCount = 0 Then
sTemp = sTemp & Me!Conditions.ItemData(oItem)
iCount = iCount + 1
Else
sTemp = sTemp & "," & Me!Conditions.ItemData(oItem)
iCount = iCount + 1
End If
Next oItem
Else
MsgBox "Nothing was selected from the list", vbInformation
Exit Sub 'Nothing was selected
End If

Me!MySelectionsB.Value = sTemp
End SubPrivate Sub testmultiselectc_Click()
Dim oItem As Variant
Dim sTemp As String
Dim iCount As Integer

iCount = 0

If Me!Issues.ItemsSelected.Count <> 0 Then
For Each oItem In Me!Issues.ItemsSelected
If iCount = 0 Then
sTemp = sTemp & Me!Issues.ItemData(oItem)
iCount = iCount + 1
Else
sTemp = sTemp & "," & Me!Issues.ItemData(oItem)
iCount = iCount + 1
End If
Next oItem
Else
MsgBox "Nothing was selected from the list", vbInformation
Exit Sub 'Nothing was selected
End If

Me!mySelectionsC.Value = sTemp
End Sub
Private Sub testmultiselectd_Click()
Dim oItem As Variant
Dim sTemp As String
Dim iCount As Integer

iCount = 0

If Me!Other.ItemsSelected.Count <> 0 Then
For Each oItem In Me!Other.ItemsSelected
If iCount = 0 Then
sTemp = sTemp & Me!Other.ItemData(oItem)
iCount = iCount + 1
Else
sTemp = sTemp & "," & Me!Other.ItemData(oItem)
iCount = iCount + 1
End If
Next oItem
Else
MsgBox "Nothing was selected from the list", vbInformation
Exit Sub 'Nothing was selected
End If

Me!MySelectionsD.Value = sTemp
End Sub
Private Sub clrList_Click()
Call clearListBox
Me!MySelections.Value = Null
End Sub

Private Sub ClrListB_Click()
Call clearListBoxB
Me!MySelectionsB.Value = Null
End Sub
Private Sub ClrListC_Click()
Call clearListBoxC
Me!mySelectionsC.Value = Null
End Sub
Private Sub ClrListD_Click()
Call clearListBoxD
Me!MySelectionsD.Value = Null
End Sub
Private Sub clearListBox()
Dim iCount As Integer

For iCount = 0 To Me!Diagnoses.ListCount
Me!Diagnoses.Selected(iCount) = False
Next iCount
End Sub

Private Sub clearListBoxB()
Dim iCount As Integer

For iCount = 0 To Me!Conditions.ListCount
Me!Conditions.Selected(iCount) = False
Next iCount
End Sub
Private Sub clearListBoxC()
Dim iCount As Integer

For iCount = 0 To Me!Issues.ListCount
Me!Issues.Selected(iCount) = False
Next iCount
End SubPrivate Sub clearListBoxD()
Dim iCount As Integer

For iCount = 0 To Me!Other.ListCount
Me!Other.Selected(iCount) = False
Next iCount
End Sub

[RuralGuy]

I have not abandon you, just real distracted at the moment. Sorry.