Results 1 to 5 of 5

Thread: Run-time error '9': Subscript out of range

  1. #1

    Thread Starter
    Registered User
    Join Date
    May 2018
    Posts
    1

    Run-time error '9': Subscript out of range

    I got this error when generating excel report from the application.

    Name:  Capture2.PNG
Views: 855
Size:  89.1 KB
    Name:  Capture.jpg
Views: 426
Size:  21.0 KB

    any way to correct/bypass this?

    Sub Load_LvP4ReworkLO(strPO As String)
    Dim rst As New ADODB.Recordset, rst2 As New ADODB.Recordset, rst3 As New ADODB.Recordset

    Dim strSQL As String, strFGLot() As String
    Dim intClassifierID() As Integer, i As Integer, j As Integer, intReworkID() As Integer
    Dim blnFGLot As Boolean, blnRunningRework As Boolean, blnReworkClassifier As Boolean
    Dim blnAgingRework As Boolean
    Dim dblReworkProduced As Double, dblAgingRework As Double, dblClassifierRework As Double
    Dim dblRunningRework As Double, dblReworkLO As Double

    'Calculate
    ' 1) Running Rework Produced
    ' 2) Running Rework Used
    ' 3) Running Rework Left Over
    ' 4) Rework in Classifier
    ' 5) Aging Rework



    BCS_Open

    blnFGLot = Load_FGLots(strPO, strFGLot, conBCS)
    LoadingPointID intClassifierID, "ClassiFier", conBCS
    LoadingPointID intReworkID, "Rework", conBCS


    Dim str As String
    str = "("
    For i = 1 To UBound(strFGLot) Step 1
    str = str + "'" + strFGLot(i) + "'"
    If i <> UBound(strFGLot) Then
    str = str + ","
    End If
    Next
    str = str + ")"

    strSQL = "select a.id as item_id,b.article_no,b.name,a.lot_no,a.quantity "
    strSQL = strSQL & "from wms.dbo.items a, wms.dbo.products b "
    strSQL = strSQL & "where a.product_id = b.id "
    strSQL = strSQL & "and a.status_id in (3,4,6) and b.category_id = 6"
    strSQL = strSQL & "and lot_no in" + str

    '//

    rst.Open strSQL, conBCS
    'Jinke 20120601
    strSQL = "select d.article_no productNum "
    strSQL = strSQL & "from wms.dbo.production_orders a,wms.dbo.finish_products d "
    strSQL = strSQL & "where prod_no = '" & strPO & "' "
    strSQL = strSQL & "and a.finish_product_id = d.id "

    rst3.Open strSQL, conBCS

    Do While rst.EOF = False
    blnRunningRework = False
    blnReworkClassifier = False

    If blnFGLot = True Then
    For i = LBound(strFGLot) To UBound(strFGLot)
    If rst!lot_no = strFGLot(i) Then
    'dblReworkProduced = dblReworkProduced + rst!quantity
    blnRunningRework = True
    Exit For
    End If
    Next i

    strSQL = "select a.id items_id, a.pick_item_id , b.picklist_id , c.production_order_id, d.prod_no, a.* "
    strSQL = strSQL & "from wms.dbo.items a, wms.dbo.pick_items b, wms.dbo.picklists c, "
    strSQL = strSQL & "wms.dbo.production_orders d "
    strSQL = strSQL & "where a.id = '" & rst!item_id & "' "
    strSQL = strSQL & "and a.pick_item_id = b.id "
    strSQL = strSQL & "and b.picklist_id = c.id "
    strSQL = strSQL & "and c.production_order_id = d.id "

    'strSQL = "select * from wms.dbo.items where id = '" & rst!item_id & "' "



    rst2.Open strSQL, conBCS
    If rst2.EOF = True Then
    dblReworkLO = dblReworkLO + rst!quantity
    With DailyReport_Details.lvP4ReworkLO.ListItems.Add
    .Text = rst3!productNum
    .SubItems(1) = rst!ARTICLE_NO
    If IsNull(rst!lot_no) = False Then .SubItems(2) = rst!lot_no
    .SubItems(3) = Round(rst!quantity, 2)
    End With
    End If
    '//

    Do While rst2.EOF = False
    If blnRunningRework = True Then
    If Not IsNull(rst2!Stock_Out_date) And rst2!prod_no = strPO Then
    For i = LBound(intClassifierID) To UBound(intClassifierID)
    If rst2!loading_point_id = intClassifierID(i) Then
    blnReworkClassifier = True
    Exit For
    End If
    Next i
    If blnReworkClassifier = True Then
    dblClassifierRework = dblClassifierRework + rst2!quantity
    With DailyReport_Details.lvP3ClassifierRework.ListItems.Add
    .Text = rst3!productNum
    .SubItems(1) = rst!ARTICLE_NO
    .SubItems(2) = rst!lot_no

    If IsNull(rst2!bag_no) Then
    .SubItems(3) = ""
    Else
    .SubItems(3) = rst2!bag_no
    End If

    .SubItems(4) = Round(rst2!quantity, 2)
    End With

    Else
    dblRunningRework = dblRunningRework + rst2!quantity

    With DailyReport_Details.lvP3RunningRework.ListItems.Add
    .Text = DailyReport_Details.txtP4MaterialNo.Text
    .SubItems(1) = rst!ARTICLE_NO
    .SubItems(2) = rst!lot_no

    If IsNull(rst2!bag_no) Then
    .SubItems(3) = ""
    Else
    .SubItems(3) = rst2!bag_no
    End If

    .SubItems(4) = Round(rst2!quantity, 2)
    End With

    '//
    End If
    Else
    dblReworkLO = dblReworkLO + rst!quantity
    With DailyReport_Details.lvP4ReworkLO.ListItems.Add
    .Text = rst3!productNum
    .SubItems(1) = rst!ARTICLE_NO
    .SubItems(2) = rst!lot_no
    .SubItems(3) = Round(rst!quantity, 2)
    End With
    End If
    End If
    rst2.MoveNext
    Loop
    rst2.Close
    Set rst2 = Nothing
    End If
    rst.MoveNext
    Loop
    rst.Close
    rst3.Close
    Set rst = Nothing



    strSQL = "select a.id productionOrder_id, b.id picklist_id, c.id pickitem_id, e.article_no ProductNum, "
    strSQL = strSQL & " (select article_no from wms.dbo.products where id = d.product_Id) reworkArticle, "
    strSQL = strSQL & " (select category_id from wms.dbo.products where id = d.product_Id) cate, d.* "
    strSQL = strSQL & "from wms.dbo.production_orders a, wms.dbo.picklists b, wms.dbo.pick_items c, wms.dbo.items d, "
    strSQL = strSQL & "wms.dbo.finish_products e "
    strSQL = strSQL & "where a.prod_no = '" & strPO & "' "
    strSQL = strSQL & "and a.id = b.production_order_id "
    strSQL = strSQL & "and b.pick_type_id=1 "
    strSQL = strSQL & "and b.id = c.picklist_id "
    strSQL = strSQL & "and c.id = d.pick_item_id "
    strSQL = strSQL & "and a.finish_product_id = e.id "
    '//

    rst.Open strSQL, conBCS
    Do While rst.EOF = False
    blnReworkClassifier = False
    blnAgingRework = False

    For i = LBound(intClassifierID) To UBound(intClassifierID)
    If rst!loading_point_id = intClassifierID(i) Then
    blnReworkClassifier = True
    Exit For
    End If
    Next i
    If blnReworkClassifier = True Then
    dblClassifierRework = dblClassifierRework + rst!quantity
    With DailyReport_Details.lvP3ClassifierRework.ListItems.Add
    .Text = rst!productNum
    .SubItems(1) = rst!reworkArticle
    .SubItems(2) = rst!lot_no
    If IsNull(rst!bag_no) Then
    .SubItems(3) = ""
    Else
    .SubItems(3) = rst!bag_no
    End If
    .SubItems(4) = Round(rst!quantity, 2)
    End With
    End If



    If CLng(rst!cate) = 6 Then
    If blnFGLot = True Then
    For i = LBound(strFGLot) To UBound(strFGLot)
    If rst!lot_no = strFGLot(i) Then
    Exit For
    End If

    If i = UBound(strFGLot) Then
    blnAgingRework = True
    End If
    Next i
    Else
    blnAgingRework = True
    End If
    End If
    '//

    If blnAgingRework = True Then
    dblAgingRework = dblAgingRework + rst!quantity
    With DailyReport_Details.lvP3AgingRework.ListItems.Add
    .Text = rst!productNum
    .SubItems(1) = rst!reworkArticle
    .SubItems(2) = rst!name
    If IsNull(rst!bag_no) Then
    .SubItems(3) = ""
    Else
    .SubItems(3) = rst!bag_no
    End If
    .SubItems(4) = Round(rst!quantity, 2)
    End With
    End If

    rst.MoveNext
    Loop
    rst.Close
    Set rst = Nothing

    'BCS_Close


    If dblRunningRework >= 0 Then
    DailyReport_Details.txtP1RunningRework = Round(dblRunningRework, 2)
    DailyReport_Details.txtP1TotalRunningRework = Round(dblRunningRework, 2)

    Dim totalQty As Double
    totalQty = GetRwkProduced(strFGLot, conBCS)
    dblReworkLO = totalQty - dblRunningRework
    DailyReport_Details.txtP1ReworkLO = Round(dblReworkLO, 2)
    End If

    If dblAgingRework > 0 Then DailyReport_Details.txtP1AgingRework = Round(dblAgingRework, 2)
    If dblClassifierRework > 0 Then DailyReport_Details.txtP1ReworkClassifier = Round(dblClassifierRework, 2)

    BCS_Close
    End Sub
    Thanks.

  2. #2
    PowerPoster Arnoutdv's Avatar
    Join Date
    Oct 2013
    Posts
    5,872

    Re: Run-time error '9': Subscript out of range

    If you get that error on that line then the array strFGLot is not initialized.

    Code:
    BCS_Open
    
    blnFGLot = Load_FGLots(strPO, strFGLot, conBCS)
    Check your Load_FGLots method and step through the code using F8.

  3. #3
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,853

    Re: Run-time error '9': Subscript out of range

    Another option would be that the LBound is out of range, but not being dimensioned is more likely. In a loop like that, I often use: For i = LBound(var) to UBound(var).

    That way, I don't have to worry about either side. But you do still have to make sure it's dimensioned.

    Good Luck,
    Elroy
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  4. #4
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    19,541

    Re: Run-time error '9': Subscript out of range

    Quote Originally Posted by Elroy View Post
    Another option would be that the LBound is out of range, but not being dimensioned is more likely.
    Not initialized is the problem. This line would not error if array was initialized, regardless of UBound:
    For i = 1 To UBound(blnFGLot)

    If 1 was greater than UBound, the loop would simply be short-circuited
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  5. #5
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,853

    Re: Run-time error '9': Subscript out of range

    Ahhh, good point.
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width