Search code examples
excelvbaloopsfor-loopruntime-error

VBA For loop works once and then on second try it creates a Run-time error

I have created a system for ordering parts that runs a macro that searches for the parts ordered by the operator, by looking for a hidden cell that indicates that the item has been ordered. The macro works as intended the first time, but when the workbook is edited (say an item was added), and the macro is run again, it generates a Run-time error '1004': Application-defined or object-defined error (the bug line is commented),

Set wb = ThisWorkbook
Set ws1 = wb.Sheets("PURCHASE ORDER")
Set ws2 = wb.Sheets("PICKING SHEET")

'Search for Ordered Units and add to Collection(Coll 9,"1" = Add row)
    For i = 19 To 150
        If Cells(i, 9).Value = 1 Then
            list.Add i
        End If
    Next i

'Clear Template
ws2.Range("A8:J45").Clear

'Add Purchase Date
ws1.Range("C5").Copy
ws2.Range("C5").PasteSpecial Paste:=xlPasteValues

'Add Order data
ws1.Range("E3:E5").Copy
ws2.Range("E3:E5").PasteSpecial Paste:=xlPasteValues

'Read Collection and add to "Order" sheet

For Each v In list
    'Debug.Print v
    'Formating Cell Borders
    ws2.Range("B8:J8").Offset(t).Borders(xlEdgeBottom).LineStyle = xlContinuous
    ws2.Range("B8:J8").Offset(t).Borders(xlInsideHorizontal).LineStyle = xlContinuous
    ws2.Range("B8:J8").Offset(t).Borders(xlInsideVertical).LineStyle = xlContinuous
    ws2.Range("B8:J8").Offset(t).Borders(xlEdgeLeft).LineStyle = xlContinuous
    ws2.Range("B8:J8").Offset(t).Borders(xlEdgeRight).LineStyle = xlContinuous
    'Copy Function
    Debug.Print v
    'Bug Postion - Only happens after macro retry, row is defined
    Set data1 = ws1.Range(Cells(v, 3), Cells(v, 5))
    Set data2 = ws1.Range(Cells(v, 10), Cells(v, 10))
    data1.Copy
    ws2.Range("B8").Offset(t).PasteSpecial Paste:=xlPasteValues
    data2.Copy
    ws2.Range("E8").Offset(t).PasteSpecial Paste:=xlPasteValues
    'Formating Cell Alingment
    ws2.Range("B8:J8").Offset(t).HorizontalAlignment = xlCenter
    'Paste Offset, every loop adds 1 and moves line to next row
    t = t + 1
Next v
Solution

  • Before EVERY Cells you should specify ws1 or ws2.
    E.g.: ws1.Cells

    Bonus.

    ws1.Range("C5").Copy
ws2.Range("C5").PasteSpecial Paste:=xlPasteValues

    is equivalent to:

    ws2.Range("C5") = ws1.Range("C5")

    Plus this shorter version is performance-wise better.