Macro to move rows from one sheet to another sheet based on a cell vaule

[d55272]

TPM Cards.xlsx

I am trying to move rows from one sheet onther sheet if a cell has the status of "complete". I have tried the record macro but I am obviously doing something wrong because it will not add it to the end of the sheet, just replaces what was in that rw. Any help would be greatly appreciated. It is driving me crazy.

[mike7952]

Its better to post a sample workbook of what your wanting to do.

[d55272]

At the risk of sounding really stupid - I don't know how to???? Tried to copy & paste but that doesn't seem to work

[mike7952]

Are you wanting to delete the row from the Table after adding it to Complete?

[d55272]

Yes, that would be great

[mike7952]

Give this a try, Im guessing every time you run the macro you want to keep adding to the bottom of Completed sheet

Please Login or Register  to view this content.

[d55272]

Thank you so much. Will give it a try tomorrow.

[mike7952]

Ok test on a copy of your wb

[d55272]

I am getting a Compile error: Syntax Error and highlighted in blue is "End SubSub abc()". I suspect it may be the double sub but when I delete one of them I still get a syntax error. Thanks in advance for all of your work & help.

[mike7952]

Are you sure u copied it correctly?

[d55272]

Below is a copy of what I have. Should the Sub Complete() at the beginning and the two End Sub at the end be there? They came up automatically so I pasted in between them.


Sub Complete()
Option Explicit
Sub abc()
Const shTable As String = "Table"
Const shComplete As String = "Complete"
Dim RangeToDelete As Range
Dim lastrow As Long, ptr As Long, ii As Long, n As Long
Dim aComplete()

With Worksheets(shTable)
lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
ReDim aComplete(1 To lastrow, 1 To 10)
For ptr = 1 To lastrow
If .Cells(ptr, "E") = "Complete" Then
If RangeToDelete Is Nothing Then
Set RangeToDelete = .Cells(ptr, "A")
Else
Set RangeToDelete = Union(RangeToDelete, .Cells(ptr, "A"))
End If
n = n + 1
For ii = 1 To 10
aComplete(n, ii) = .Cells(ptr, ii)
Next
End If
Next ptr
If Not RangeToDelete Is Nothing Then
RangeToDelete.EntireRow.Delete
End If
End With

If n > 0 Then
With Worksheets(shComplete)
With .Range("a" & Rows.Count).End(xlUp).Offset(1).Resize(n, UBound(aComplete, 2))
.Value = aComplete
.Borders.LineStyle = xlContinuous
End With
End With
End If
Erase aComplete
End Sub
End Sub

[mike7952]

Remove sub complete at the top and one of the end sub at the bottom

[d55272]

Now no error mesages but nothing happens. When I use the step into, the sub complete is gone, there is a line all the way across the sheet under option explicit and the sub abc is highlighted in yellow with a yellow arrow beside it. I must be doing something wrong but I have no clue what.

[mike7952]

I'm away from my computer, it'll be a few hours before I can get back to it.

[WasWodge]

In the VBE editor click Run then click reset, place your cursor at the start of Sub abc() then click Run then Run.

[d55272]

Thanks for the help but nothing is happening - but no error messages

[WasWodge]

Mike's code is working fine for me in a copy of the workbook you put in post #1.

I have placed a copy of the workbook with the macro in place in the link below and have assigned it a shortcut of Ctrl-Shift-J to run the macro.

Obviously make sure that you have enabled the Macro's when you open the workbook