Error #9 : Subscript out of range

[rburna904]

Ok I have the following code which keeps producing an Error # 9 : subscript out of range.....

Public Sub SaveLineItems()
On Error GoTo SaveLineItem_Error
MsgBox "I am doing the line items"
Dim sSQL As String
Dim iLine As Integer
Dim iMaxLines As Integer
Dim iMonthCount As Integer
Dim iFieldCount As Integer
Dim sThisField As String
Dim sFieldPrefix As String
Dim aFields, aMonths, sInDirectCostId, sFY, sUser
sFY = [Forms]![SWITCHBOARD]![cboFY]
sUser = [Forms]![SWITCHBOARD]![txtUser]
sInDirectCostId = sFY & sUser
aFields = Array("cboDesc", "txt", "txtMemo")
aMonths = Array("OCT", "NOV", "DEC", "JAN", "FEB", "MAR", "APR", "MAY", "JUN", "JUL", "AUG", "SEP")
iMonthLoop = 0
iMonthCount = 11
iMaxLines = 16
iLine = 1
Do While iLine <= iMaxLines
    iMonthLoop = 0
    If Me.Controls(aFields(0) & iLine) <> "" And Me.Controls(aFields(0) & iLine).Locked = True Then
       If Me.Controls(aFields(0) & iLine).Column(2) = -1 And Me.Controls(aFields(3) & iLine) = "" Then
            MsgBox "You must have a memo for the program : " & Me.Controls(aFields(0) & iLine), vbOKOnly, "Missing Information"
            Me.Controls(aFields(3) & iLine).SetFocus
            Exit Sub
       Else
        sSQL = "UPDATE BUDGET_INDIRECTCOSTS_R_LINEDETAILS SET " & _
               "ProgramId = " & Me.Controls(aFields(0) & iLine) & ", " & _
               "Memo = " & Me.Controls(aFields(2) & iLine) & ", "
        Do While iMonthLoop <= iMonthCount
            sSQL = sSQL & aMonths(iMonthLoop) & " = " & Me.Controls(aFields(1) & aMonths(iMonthLoop) & iLine)
            If iMonthLoop < iMonthCount Then
                sSQL = sSQL & ", "
            End If
            iMonthLoop = iMonthLoop + 1
        Loop
        sSQL = sSQL & " WHERE INDIRECTCOSTID = " & sInDirectCostId & " AND ID " = iLine
       End If
    ElseIf Me.Controls(aFields(0) & iLine) <> "" Then
        If Me.Controls(aFields(0) & iLine).Column(2) = -1 And Me.Controls(aFields(3) & iLine) = "" Then
            MsgBox "You must have a memo for the program : " & Me.Controls(aFields(0) & iLine), vbOKOnly, "Missing Information"
            Me.Controls(aFields(3) & iLine).SetFocus
            Exit Sub
        Else
        sSQL = "INSERT INTO BUDGET_INDIRECTCOSTS_R_LINEDETAILS " & _
               "(Id, ProgramId, Memo"
        Do While iMonthLoop <= iMonthCount
            sSQL = sSQL & ", " & aMonths(iMonthLoop)
            If iMonthLoop = iMonthCount Then
                sSQL = sSQL & ") VALUES ("
            End If
            iMonthLoop = iMonthLoop + 1
        Loop
        iMonthLoop = 0
        sSQL = sSQL & "" & iLine & ",'" & Me.Controls(aFields(0) & iLine) & "','" & Me.Controls(aFields(2) & iLine) & "'"
        Do While iMonthLoop <= iMonthCount
            sSQL = sSQL & ", " & Me.Controls(aFields(1) & aMonths(iMonthLoop) & iLine)
            If iMonthLoop = iMonthCount Then
                sSQL = sSQL & ")"
            End If
            iMonthLoop = iMonthLoop + 1
        Loop
        End If
    End If
    MsgBox sSQL
    If Len(Trim(sSQL)) > 0 Then
        Set db = CurrentDb
        db.Execute sSQL
    End If
    iLine = iLine + 1
Loop
SaveLineItem_Error:
    If Err.Number <> 0 Then
        MsgBox "Line Item Save Error : " & Err.Number & vbCrLf & Err.Description
    End If
End Sub

I have gone through and commented everything out and brought back only parts and here is what I have when I get the error the first time....

Public Sub SaveLineItems()
On Error GoTo SaveLineItem_Error
MsgBox "I am doing the line items"
Dim sSQL As String
Dim iLine As Integer
Dim iMaxLines As Integer
Dim iMonthCount As Integer
Dim iFieldCount As Integer
Dim sThisField As String
Dim sFieldPrefix As String
Dim aFields, aMonths, sInDirectCostId, sFY, sUser
sFY = [Forms]![SWITCHBOARD]![cboFY]
sUser = [Forms]![SWITCHBOARD]![txtUser]
sInDirectCostId = sFY & sUser
aFields = Array("cboDesc", "txt", "txtMemo")
aMonths = Array("OCT", "NOV", "DEC", "JAN", "FEB", "MAR", "APR", "MAY", "JUN", "JUL", "AUG", "SEP")
iMonthLoop = 0
iMonthCount = 11
iMaxLines = 16
iLine = 1
Do While iLine <= iMaxLines
    iMonthLoop = 0
    If Me.Controls(aFields(0) & iLine) <> "" And Me.Controls(aFields(0) & iLine).Locked = True Then
       If Me.Controls(aFields(0) & iLine).Column(2) = -1 And Me.Controls(aFields(3) & iLine) = "" Then
            MsgBox "You must have a memo for the program : " & Me.Controls(aFields(0) & iLine), vbOKOnly, "Missing Information"
       End If
    ElseIf Me.Controls(aFields(0) & iLine) <> "" Then
        If Me.Controls(aFields(0) & iLine).Column(2) = -1 And Me.Controls(aFields(3) & iLine) = "" Then
            MsgBox "You must have a memo for the program : " & Me.Controls(aFields(0) & iLine), vbOKOnly, "Missing Information"
        End If
    End If
    iLine = iLine + 1
Loop
SaveLineItem_Error:
    If Err.Number <> 0 Then
        MsgBox "Line Item Save Error : " & Err.Number & vbCrLf & Err.Description
    End If
End Sub

I have gone and researched the problem and have not been able to find anything that relates to this......

Thanks,
Richard

 

[rburna904]

I figured it out....

Me.Controls(aFields(3) & iLine) should be Me.Controls(aFields(2) & iLine)