Macro to move row to another worksheet

[emjeff99]

Hi! I have a workbook with two worksheets in it. The first "TO DO" and the second "Completed". In "TO DO", I have rows of tasks starting in row 4 (row 3 is my header), going to 200. What I'd like to have happen is when I put a "C" in column C, it moves the entire row to the "Completed" worksheet, greys it out and removes it from the "TO DO" worksheet. Then if I remove the "C" from the "Completed" worksheet, it moves it back to the bottom of the list. I already have a macro to resort it based on "priority" in column E.

Is this even possible???

As always, thanks! You all are so awesome!!!

 

[Smitty]

Why don't you use Auto Filter instead. If you filter on 0, you can goto Edit-->Special Cells-->Visible cells only then cut and paste them. It'll be a lot faster than trying to loop.

 

[lall]

Why don't you use Auto Filter instead. If you filter on 0, you can goto Edit-->Special Cells-->Visible cells only then cut and paste them. It'll be a lot faster than trying to loop.

Cause i may have up to 100 000+ rows to move..so autofilter is off.
And i need it every day.

 

[Smitty]

How about sorting on 0 then?

Better yet, do you have Access? That would be a very simple query. 100,000 rows is going to be difficult to loop through.

 

[lall]

How about sorting on 0 then?

Better yet, do you have Access? That would be a very simple query. 100,000 rows is going to be difficult to loop through.

Can't do so.
I have pretty complicated database in excel. And there are many very specific macros in my workbook. It's not just a regular excel table. Lot more. And i can't move it into access, because..there are several reasons. the first is that we don't have access in company. only excel licenses.
Some another good idea? :D

 

[Smitty]

OK, I tweaked your code a bit:

<font face=Tahoma><SPAN style="color:#00007F">Sub</SPAN> moveZeroRows()<br>    <SPAN style="color:#00007F">Dim</SPAN> X <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, LastRow <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>    <br>    Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN><br>        <SPAN style="color:#00007F">For</SPAN> X = ActiveSheet.Cells(Rows.Count, "R").End(xlUp).Row <SPAN style="color:#00007F">To</SPAN> 1 <SPAN style="color:#00007F">Step</SPAN> -1<br>            <SPAN style="color:#00007F">If</SPAN> ActiveSheet.Cells(X, "R").Value = 0 <SPAN style="color:#00007F">Then</SPAN><br>                LastRow = Sheets("Sheet5").Cells(Rows.Count, "A").End(xlUp).Offset(1).Row<br>                ActiveSheet.Cells(X, "A").EntireRow.Cut Destination:=Sheets("Sheet5").Range("A" & LastRow)<br>            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>        <SPAN style="color:#00007F">Next</SPAN><br>    Application.ScreenUpdating = <SPAN style="color:#00007F">True</SPAN><br>    <br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>

 

[jmthompson]

I'm a relative newbie too, but if you notice when you do this action manually, it leaves blank rows after cutting and pasting too. What I have done to get around this is to perform two loops, the first copying and pasting all rows with the specified value, the second deleting all rows with the speficied value.

Something like (UNTESTED):

Sub moveZeroRows()
Sheets("Sheet2").Select   
LSearchRow = 2
 
While Len(Range("A" & CStr(LSearchRow)).Value) > 0
If Range("R" & CStr(LSearchRow)).Value = 0 Then
Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
Selection.Copy
Sheets("Sheet5").Select
LCopyToRow = (Worksheets("Sheet5").Range("A" & Rows.Count).End(xlUp).Row)+1
Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
ActiveSheet.Paste
Sheets("Sheet2").Select
End If
LSearchRow = LSearchRow + 1
Wend
<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" /><o:p> </o:p>
Last = Cells(Rows.Count, "A").End(xlUp).Row
For i = Last To 2 Step -1
If (Cells(i, "R").Value) = 0 Then
Cells(i, "A").EntireRow.Delete
End If
Next i

 

[lall]

OK, I tweaked your code a bit:

Sub moveZeroRows()
Dim X As Long, LastRow As Long

Application.ScreenUpdating = False
For X = ActiveSheet.Cells(Rows.Count, "R").End(xlUp).Row To 1 Step -1
If ActiveSheet.Cells(X, "R").Value = 0 Then
LastRow = Sheets("Sheet5").Cells(Rows.Count, "A").End(xlUp).Offset(1).Row
ActiveSheet.Cells(X, "A").EntireRow.Cut Destination:=Sheets("Sheet5").Range("A" & LastRow)
End If
Next
Application.ScreenUpdating = True

End Sub

Yeah, it works..slowly but works :D
But what can i do to get the macro not to leave empty spaces behind?

 

[Smitty]

Just sort it:

<font face=Tahoma>        ActiveSheet.UsedRange.Sort Key1:=Range("R1"), Order1:=xlAscending, Header:=xlGuess, _<br>            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _<br>            DataOption1:=xlSortNormal</FONT>

 

[lall]

Just sort it:

ActiveSheet.UsedRange.Sort Key1:=Range("R1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

Yeah, just my idea :D
Thanks man.
But this won't delete the empty rows. Any medicament for that?

 

[lall]

I'm a relative newbie too, but if you notice when you do this action manually, it leaves blank rows after cutting and pasting too. What I have done to get around this is to perform two loops, the first copying and pasting all rows with the specified value, the second deleting all rows with the speficied value.

Something like (UNTESTED):

Sub moveZeroRows()
Sheets("Sheet2").Select   
LSearchRow = 2
 
While Len(Range("A" & CStr(LSearchRow)).Value) > 0
If Range("R" & CStr(LSearchRow)).Value = 0 Then
Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
Selection.Copy
Sheets("Sheet5").Select
LCopyToRow = (Worksheets("Sheet5").Range("A" & Rows.Count).End(xlUp).Row)+1
Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
ActiveSheet.Paste
Sheets("Sheet2").Select
End If
LSearchRow = LSearchRow + 1
Wend
<o:p> </o:p>
Last = Cells(Rows.Count, "A").End(xlUp).Row
For i = Last To 2 Step -1
If (Cells(i, "R").Value) = 0 Then
Cells(i, "A").EntireRow.Delete
End If
Next i

That works fine, but it's the slowest way ever possible. The best way is to move rows/values without selecting them. I have posted some samples before here..somewhere. But i couldn't get them work 100%.
And if i have 100 000 rows then 2 loops will kill everything. Even Chuck Norris :D