Can't add this item. Index is too large.

I have a form with a list box.  For the functionality in question I select items from a list box and click on a button where some processing is performed.  I have two forms that do the same thing, just with different data.  One form works the other does not.  I can't figure it out.

The functionality is that the process loops through each item in the list box.  It updates records in the database and then updates the record on the list box.  The list box record are not bound to the database or a query, so I remove a record and then add it back.  This works on one form but not the other.  The error I get is "Can't add this item.  Index is too large".

I have tried to find differences between the code and the list box properties and except for one list box having more columns than the other, I don't see a difference.

********************* Good Code ******************************
Private Sub cmdSetScenario_Click()
On Error GoTo Err_cmdSetScenario_Click

Dim ctl             As ListBox
Dim intCount1       As Integer
Dim intCount2       As Integer
Dim varItm          As Variant
Dim strSelected()   As String
Dim intSelected()   As Integer
Dim strKey()        As String
Dim strSQL          As String
Dim lngInst         As Long

    Set ctl = Forms("frmSetScenario")!lstServices

    ReDim intSelected(ctl.ItemsSelected.Count)
    ReDim strSelected(ctl.ItemsSelected.Count)
    intCount1 = 0
    For Each varItm In ctl.ItemsSelected
        strSelected(intCount1) = ctl.Column(0, varItm)
        intSelected(intCount1) = varItm
        intCount1 = intCount1 + 1
    Next varItm
   
    lngInst = Nz(DMax("lngScenarioInstance", "tbllnkProductCmpGrp"), 0) + 1
    For intCount2 = 0 To intCount1 - 1 Step 1
        strKey = Split(strSelected(intCount2), "~")
        strSQL = "UPDATE tbllnkProductCmpGrp "
        strSQL = strSQL & "SET strProvScenario  = '" & strSelectedScenarioID & "', "
        strSQL = strSQL & "lngScenarioInstance = " & lngInst & " "
        strSQL = strSQL & "WHERE dblProductAcctID = " & Trim(strKey(0))
        strSQL = strSQL & "  AND dblOccurrenceNumber = " & Trim(strKey(1))
        strSQL = strSQL & "  AND strCompGrpCode = '" & Trim(strKey(2)) & "' "
        strSQL = strSQL & "  AND strCompGrpVal = '" & Trim(strKey(3)) & "'; "
        DoCmd.RunSQL strSQL
        Call UpdateListBox(9, intSelected(intCount2), strSelectedScenarioText)
    Next intCount2


Exit_cmdSetScenario_Click:
    Exit Sub

Err_cmdSetScenario_Click:
    MsgBox Err.Description
    Resume Exit_cmdSetScenario_Click

End Sub

--------------------------------

Private Sub UpdateListBox(intCol As Integer, intRow As Integer, _
                            strValue As String)
On Error GoTo Err_UpdateListBox

Dim ctl         As ListBox
Dim strRow      As String
Dim intI        As Integer

    Set ctl = Me.lstServices
    strRow = ""
    For intI = 0 To ctl.ColumnCount - 1
        If intI = intCol Then
            strRow = strRow & ";" & strValue
        Else
            strRow = strRow & ";" & ctl.Column(intI, intRow)
        End If
    Next intI
    strRow = Right(strRow, Len(strRow) - 1)
    ctl.RemoveItem (intRow)
    ctl.AddItem strRow, intRow
   
Exit_UpdateListBox:
    Exit Sub

Err_UpdateListBox:
    MsgBox Err.Description
    Resume Exit_UpdateListBox

End Sub

********************* Erring Code ******************************

Private Sub cmdSetCircuit_Click()
On Error GoTo Err_cmdSetCircuit_Click

Dim ctl             As ListBox
Dim intCount1       As Integer
Dim intCount2       As Integer
Dim varItm          As Variant
Dim strSelected()   As String
Dim intSelected()   As Integer
Dim strKey()        As String
Dim strSQL          As String
Dim lngInst         As Long
Dim strWhere        As String
Dim dblPA           As Double
Dim dblOccNum       As Double
Dim strCmpCode      As String
Dim strScenario     As String

    Set ctl = Forms("frmSetDedCircuit")!lstServices

    ReDim intSelected(ctl.ItemsSelected.Count)
    ReDim strSelected(ctl.ItemsSelected.Count)
    intCount1 = 0
    For Each varItm In ctl.ItemsSelected
        strSelected(intCount1) = ctl.Column(0, varItm)
        intSelected(intCount1) = varItm
        intCount1 = intCount1 + 1
    Next varItm
   
    strWhere = "strCompGrpCode = 'LL' " & _
                "and strAppCode = 'DED' " & _
                "and strLATISLitelCircuitID = '" & strSelectedCircuitID & "'"

    dblPA = DLookup("dblProductAcctID", "tbllnkProductCmpGrp", strWhere)
    dblOccNum = DLookup("dblOccurrenceNumber", "tbllnkProductCmpGrp", strWhere)
    strWhere = "dblProductAcctID = " & dblPA & " AND dblOccurrenceNumber = " & dblOccNum
    strCmpCode = DLookup("strComponentCode", "tbllnkProductCmp", strWhere)
    Select Case strCmpCode
    Case "BS LOOP"
        strScenario = "18"
    Case "BSQP LOOP"
        strScenario = "19"
    End Select

    lngInst = Nz(DMax("lngScenarioInstance", "tbllnkProductCmpGrp"), 0) + 1
    For intCount2 = 0 To intCount1 - 1 Step 1
        strKey = Split(strSelected(intCount2), "~")
        strSQL = "UPDATE tbllnkProductCmpGrp "
        strSQL = strSQL & "SET strLATISLitelCircuitID  = '" & strSelectedCircuitID & "', "
        strSQL = strSQL & "strProvScenario = '" & strScenario & "', "
        strSQL = strSQL & "lngScenarioInstance = " & lngInst & ", "
        strSQL = strSQL & "strRecordStatus = 'DED-Complete' "
        strSQL = strSQL & "WHERE dblProductAcctID = " & Trim(strKey(0))
        strSQL = strSQL & "  AND dblOccurrenceNumber = " & Trim(strKey(1))
        strSQL = strSQL & "  AND strCompGrpCode = '" & Trim(strKey(2)) & "' "
        strSQL = strSQL & "  AND strCompGrpVal = '" & Trim(strKey(3)) & "'; "
        DoCmd.RunSQL strSQL
        Call UpdateListBox(9, intSelected(intCount2), "DED-Complete")
    Next intCount2


Exit_cmdSetCircuit_Click:
    Exit Sub

Err_cmdSetCircuit_Click:
    MsgBox Err.Description
    Resume Exit_cmdSetCircuit_Click

End Sub

------------------------

Private Sub UpdateListBox(intCol As Integer, intRow As Integer, _
                            strValue As String)
On Error GoTo Err_UpdateListBox

Dim ctl         As ListBox
Dim strRow      As String
Dim intI        As Integer

    Debug.Print "ListCount:   " & Me.lstServices.ListCount
    Debug.Print "ColumnCount: " & Me.lstServices.ColumnCount
    Debug.Print "IntRow:      " & intRow
   
   
    Set ctl = Me.lstServices
    strRow = ""
    For intI = 0 To ctl.ColumnCount - 1
        If intI = intCol Then
            strRow = strRow & ";" & strValue
        Else
            strRow = strRow & ";" & ctl.Column(intI, intRow)
        End If
    Next intI
    strRow = Right(strRow, Len(strRow) - 1)
    ctl.RemoveItem (intRow)
    ctl.AddItem strRow, intRow  **************** Code fails here ************************
   
Exit_UpdateListBox:
    Exit Sub

Err_UpdateListBox:
    MsgBox Err.Description
    Resume Exit_UpdateListBox

End Sub
LVL 1
tdfreemanAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

tdfreemanAuthor Commented:
By the way it only happens if I select the last list row.
GRayLCommented:
As a quickie, integer goes out of range at 32768.  Long is a heck of a lot bigger.
tdfreemanAuthor Commented:
Thanks, but the user should never select that many records into the list.

I have found a work around but I don't have the answer to why.  The work around is to change the two lines, the line that fails and the line above it to:

   ctl.AddItem strRow, intRow
   ctl.RemoveItem (intRow + 1)

I will give points to someone if they can help figure out why one form allows me to add back to the end of a list when the other does not.
LunchyCommented:
Closed, 500 points refunded.
Lunchy
Friendly Neighbourhood Community Support Admin

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Access

From novice to tech pro — start learning today.