Error - Do Until with iRows and kRows?

[whahmira]

Hello! I have created a template Order Form that a user is to fill out. When they are done, they click a "Ship" button. That button opens up a workbook with a list of all of the Shipments placed through clicking that button and adds the new parts being ordered to the list. In addition, the Packing List is saved under its own file with a unique ShipNo.

The problem is that when the parts are being put into the new list, they are repeating over each other instead of adding to the list. So, if the list already has 3 parts in it and I add 3 more, those parts are overwritten by the new ones. My code is listed below. I placed green comments where I have tried different ideas. Sometimes it would add only one part to the list, sometimes it would add none. I need it to add all of them. Any help would be greatly appreciated ​

[LEFT][COLOR=#333333][FONT=monospace]Sub ShipTest()
    
Application.ScreenUpdating = False
[/FONT][/COLOR][/LEFT][COLOR=#008000][LEFT][COLOR=#008000][FONT=monospace]
'This section copies the Packing List and Shipping Document and moves it to a new Workbook created[/FONT][/COLOR][/LEFT][/COLOR][LEFT][COLOR=#333333][FONT=monospace]
    Dim ShipNo As Long
    ShipNo = Sheets("2018 Packing List").Cells(3, 11).Value [/FONT][/COLOR][/LEFT][COLOR=#008000][LEFT][COLOR=#008000][FONT=monospace] 'this cell is hidden in white ink so that the ShipNo is correct in cell to left of it[/FONT][/COLOR][/LEFT][/COLOR][LEFT][COLOR=#333333][FONT=monospace]
    Sheets("2018 Packing List").Cells(3, 11).Value = Sheets("2018 Packing List").Cells(3, 11).Value + 1
    Filenm = Sheets("Order Form").Cells(1, 2).Value [/FONT][/COLOR][/LEFT][COLOR=#008000][LEFT][COLOR=#008000][FONT=monospace]'reference to the filename[/FONT][/COLOR][/LEFT][/COLOR][LEFT][COLOR=#333333][FONT=monospace]
    Sheets(Array("2018 Packing List", "Shipping Request Form")).Copy
    ChDir "C:\Users\Z645352\Desktop\Test1\ShippingDoc\"
    ActiveWorkbook.SaveAs FileFormat:=xlOpenXMLWorkbookMacroEnabled, Filename:= _
        "C:\Users\Z645352\Desktop\Test1\ShippingDoc" & Filenm & "2018" & ShipNo & ".xlsm"
    
    ActiveWindow.Close savechanges:=False
    

[/FONT][/COLOR][/LEFT][COLOR=#008000][LEFT][COLOR=#008000][FONT=monospace]'This section copies the necessary information from Order Form to Shipments[/FONT][/COLOR][/LEFT][/COLOR][LEFT][COLOR=#333333][FONT=monospace]
Sheets("Order Form").Activate
OrderNo = Range("B2").Value
Dim PartNo(100) As String
Dim Quantity(100) As Integer

Dim iRow As Integer
   iRow = 8 [/FONT][/COLOR][/LEFT][COLOR=#008000][LEFT][COLOR=#008000][FONT=monospace]'start one row early or it will skip the first row of the order[/FONT][/COLOR][/LEFT][/COLOR][LEFT][COLOR=#333333][FONT=monospace]
   Do Until IsEmpty(Cells(iRow, 1))
   iRow = iRow + 1
   PartNo(iRow) = Cells(iRow, 1).Value
   Quantity(iRow) = Cells(iRow, 5).Value
   Loop
maxRow = iRow
iRow = 9 [/FONT][/COLOR][/LEFT][COLOR=#008000][LEFT][COLOR=#008000][FONT=monospace]'added this line to stop error of adding extra empty row[/FONT][/COLOR][/LEFT][/COLOR][LEFT][COLOR=#333333][FONT=monospace]

[/FONT][/COLOR][/LEFT][COLOR=#008000][LEFT][COLOR=#008000][FONT=monospace]'opens up the ship list[/FONT][/COLOR][/LEFT][/COLOR][LEFT][COLOR=#333333][FONT=monospace]
Workbooks.Open Filename:= _
        "C:\Users\Z645352\Desktop\Test1\WorkbookB.xlsm"

[/FONT][/COLOR][/LEFT][COLOR=#008000][LEFT][COLOR=#008000][FONT=monospace]'name the kRow[/FONT][/COLOR][/LEFT][/COLOR][LEFT][COLOR=#333333][FONT=monospace]
Sheets("Shipments").Activate
kRow = 6

[/FONT][/COLOR][/LEFT][COLOR=#ff0000][LEFT][COLOR=#FF0000][FONT=monospace]'-------------------------THIS IS WHERE THE ERROR OCCURS-----------------------[/FONT][/COLOR][/LEFT][/COLOR][LEFT][COLOR=#333333][FONT=monospace]
    Do Until iRow = maxRow
[/FONT][/COLOR][/LEFT][COLOR=#008000][LEFT][COLOR=#008000][FONT=monospace]'   Do Until IsEmpty(Cells(kRow, 1))
'   iRow = maxRow 'do until the list is done[/FONT][/COLOR][/LEFT][/COLOR][LEFT][COLOR=#333333][FONT=monospace]
    
Cells(kRow, 1).Value = PartNo(iRow)
Cells(kRow, 4).Value = Quantity(iRow)
Cells(kRow, 3).Value = Filenm
Cells(kRow, 2).Select [/FONT][/COLOR][/LEFT][COLOR=#008000][LEFT][COLOR=#008000][FONT=monospace]'add a hyperlink to the cell where the ShipNo appears[/FONT][/COLOR][/LEFT][/COLOR][LEFT][COLOR=#333333][FONT=monospace]
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="C:\Users\Z645352\Desktop\Test1\ShippingDoc\" & Filenm & "2018" & ShipNo & ".xlsm", TextToDisplay:=Filenm & "2018" & ShipNo
    
[/FONT][/COLOR][/LEFT][COLOR=#008000][LEFT][COLOR=#008000][FONT=monospace]'    Do Until iRow = iRow + 1[/FONT][/COLOR][/LEFT][/COLOR][COLOR=#008000][LEFT][COLOR=#008000][FONT=monospace] 'so that the code will not continue to rewrite in the same row over and over again[/FONT][/COLOR][/LEFT][/COLOR][LEFT][COLOR=#333333][FONT=monospace]
     iRow = iRow + 1
     kRow = kRow + 1
    Loop
[/FONT][/COLOR][/LEFT][COLOR=#ff0000][LEFT][COLOR=#FF0000][FONT=monospace]'---------------------------------end of errors-----------------------------------[/FONT][/COLOR][/LEFT][/COLOR][LEFT][COLOR=#333333][FONT=monospace]
    
ActiveWorkbook.Save

Application.CutCopyMode = False
Application.ScreenUpdating = True


End Sub[/FONT][/COLOR][/LEFT]

As of right now, is still also overwriting previous rows in the list. I've added an example order form and shipments list as attachments for help. Any ideas?​

 

[whahmira]

Sorry, I cannot figure out how to upload the workbooks! So my code is listed above I hope that is enough

 

[whahmira]

the code was fixed with:

[LEFT][COLOR=#333333][FONT=monospace] 
With Sheets("Shipments")
        kRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
End With

 '-------------------------THIS IS WHERE THE ERROR OCCURS-----------------------[/FONT][/COLOR][/LEFT]

by davesexcel in exelforum

 

[Fluff]

While we do not prohibit Cross-Posting on this site, we do ask that you please mention you are doing so and provide links in each of the threads pointing to the other thread (see rule 13 here along with the explanation: Forum Rules).
This way, other members can see what has already been done in regards to a question, and do not waste time working on a question that may already be answered.

In future please supply links.