Attempting to Archive data in a worksheet

[JDoc27]

Hi Guys,

I am currently trying to archive data from a worksheet that is in continual use.

What I would like to happen is that when an action is listed as Complete then that row from the worksheet is moved into the next available row of a new one, this is the current VBA I am attempting to use but I keep being met with the error "Run-time error '1004': Application-defined or object-defined error".
Sub Archive()
Dim r As Long, endRow As Long, pasteRowIndex As Long


endRow = 10 '
pasteRowIndex = 1


For r = 1 To endRow


If Cells(r, Columns("E").Column).Value = "Complete" Then

Rows(r).Select
Selection.Copy


Sheets("Archive").Select
Rows(pasteRowIndex).Select
ActiveSheet.Paste


pasteRowIndex = pasteRowIndex + 1




Sheets("Queries").Select
End If
Next r
End Sub

I should also mention that the description Complete is one criterion of a drop down menu.

I would be grateful if somebody could please identify where I am going wrong with this.

Thanks

 

[mumps]

Copy and paste this macro into the worksheet code module. Do the following: right click the tab for your "Queries" sheet and click 'View Code'. Paste the macro into the empty code window that opens up. Close the code window to return to your sheet. The macro will be run automatically when you choose "Complete" in column E.

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.ScreenUpdating = False
    If Intersect(Target, Range("E:E")) Is Nothing Then Exit Sub
    If Target = "Complete" Then
        Target.EntireRow.Copy Sheets("Archive").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
    End If
    Application.ScreenUpdating = True
End Sub

 

[JDoc27]

Thanks for the help Mumps.

Every time a row is changed to Complete it is overwriting the previous row that has been copied over. Can you help with this?

Also I would like to have it delete from the originating table once it has been copied.

Many Thanks

 

[mumps]

Try:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("E:E")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    On Error GoTo errHandler
    If Target = "Complete" Then
        Target.EntireRow.Copy Sheets("Archive").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
        Target.EntireRow.Delete
    End If
errHandler:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

When I tested the code on some dummy data, it worked properly without overwriting the previous row. If it still doesn't work properly, perhaps you could upload a copy of your file to a free site such as www.box.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. It will be easier to check out the problem if I can see your file.