Intermittent Pasting Errors

[chrisreisinger79]

The attached picture at the bottom of the thread is the main sheet from my workbook. I have code which when you enter the date in "Date Ordered" column, column I, it copies that entire row (from A-K) and pastes/links the information into the Order List and Summary sheets and is sorted alphabetically by category. After that, when a date is entered into the "Received Date" column on the main sheet, the item is removed from the Order List sheet but remains in the Summary sheet. Most of the time this works fine. However, occasionally I get a "Microsoft cannot paste the data" or a "No Link to Paste" error. When this happens, the row is still selected in the main sheet. Below is the code.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim C As Range
   
    If Intersect(Target, Me.Range("I:I")) Is Nothing Then Exit Sub
    For Each C In Intersect(Target, Me.Range("I:I")).Cells
        'Application.ScreenUpdating = False
        If C.Value > 0 Then
            Sheets("Order List").Select
            Sheets("Order List").Range("A500").End(xlUp).Offset(1).Select
            ActiveCell.Offset(1).EntireRow.Insert
            Sheets("Inventory List").Select
            Cells(Application.ActiveCell.Row, 1).Select
            ActiveCell.Columns("A:K").Select
            ActiveCell.Columns("A:K").Activate
            Selection.Copy
            Sheets("Order List").Select
            Sheets("Order List").Range("A500").End(xlUp).Offset(1).Select
            ActiveSheet.Paste Link:=True
            Worksheets("Inventory List").Activate
            Worksheets("Order List").Range("A:A").NumberFormat = "General"
        End If
        If C.Value > 0 Then
            Sheets("Summary").Select
            Sheets("Summary").Range("A500").End(xlUp).Offset(1).Select
            ActiveCell.Offset(1).EntireRow.Insert
            Sheets("Inventory List").Select
            Cells(Application.ActiveCell.Row, 1).Select
            ActiveCell.Columns("A:K").Select
            ActiveCell.Columns("A:K").Activate
            Selection.Copy
            Sheets("Summary").Select
            Sheets("Summary").Range("A500").End(xlUp).Offset(1).Select
            ActiveSheet.Paste Link:=True
            Worksheets("Inventory List").Activate
            Worksheets("Summary").Range("A:A").NumberFormat = "General"
        End If
        'Application.ScreenUpdating = True
    Next
End Sub

I wanted to attach the file...but I don't see anywhere to do that?

 

[Larry Haydn]

Could it be that the row to be pasted is greater that row 500?
If that is the case, you can change the Range("A500") to Range("A1048576").
If Range("A1048576") raises an error, then you are using an older version of Excel that has only 65536 rows. In this case, set it to Range("A65535")

 

[chrisreisinger79]

I have yet to come close to 500 but I changed the value anyway. The errors still occur intermittently.