Multi-Select Listbox VBA code causing overflow in loop

[Mark Burk]

Private Sub Form_Current()
Dim oItem1 As Variant
Dim oItem2 As Variant
Dim bFound1 As Boolean
Dim bFound2 As Boolean
Dim sTemp1 As String
Dim sTemp2 As String
Dim sValue1 As String
Dim sValue2 As String
Dim sChar1 As String
Dim sChar2 As String
Dim iCount1 As Integer
Dim iCount2 As Integer
Dim iListItemsCount1 As Integer
Dim iListItemsCount2 As Integer


sTemp1 = Nz(Me!SignsList.Value, " ")
sTemp2 = Nz(Me!SymptomsList.Value, " ")
iListItemsCount1 = 0
iListItemsCount2 = 0
bFound1 = False
bFound2 = False
iCount1 = 0
iCount2 = 0

Call clearListBox1

For iCount1 = 1 To Len(sTemp1) + 1
sChar1 = Mid(sTemp1, iCount1, 1)
If StrComp(sChar1, ",") = 0 Or iCount1 = Len(sTemp1) + 1 Then
bFound1 = False
Do
If StrComp(Trim(Me![Objective (Sign)
2].ItemData(iListItemsCount1)), Trim(sValue1)) = 0 Then
Me![Objective (Sign) 2].Selected(iListItemsCount1) =
True
bFound1 = True
End If
iListItemsCount1 = iListItemsCount1 + 1
---- > Loop Until ((bFound1 = True) Or (iListItemsCount1 =
Me![Objective (Sign) 2].ListCount))
sValue1 = ""
Else
sValue1 = sValue1 & sChar1
End If
Next iCount1

For iCount2 = 1 To Len(sTemp2) + 1
sChar2 = Mid(sTemp2, iCount2, 1)
If StrComp(sChar2, ",") = 0 Or iCount2 = Len(sTemp2) + 1 Then
bFound2 = False
Do
If StrComp(Trim(Me![Subjective (Symptoms)
1].ItemData(iListItemsCount2)), Trim(sValue2)) = 0 Then
Me![Subjective (Symptoms) 1].Selected(iListItemsCount2) =
True
bFound2 = True
End If
iListItemsCount2 = iListItemsCount2 + 1
Loop Until bFound2 = True Or iListItemsCount2 = Me![Subjective
(Symptoms) 1].ListCount
sValue2 = ""
Else
sValue2 = sValue2 & sChar2
End If
Next iCount2


End Sub

 

[Douglas J. Steele]

ListCount is going to be 1 larger than the largest item number. (The item
numbering starts at 0)