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]

See if this does what you want:

<font face=Tahoma><SPAN style="color:#00007F">Private</SPAN> <SPAN style="color:#00007F">Sub</SPAN> Workbook_SheetChange(<SPAN style="color:#00007F">ByVal</SPAN> Sh <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Object</SPAN>, <SPAN style="color:#00007F">ByVal</SPAN> Target <SPAN style="color:#00007F">As</SPAN> Range)<br>    <SPAN style="color:#007F00">'   Code goes in the Worksheet specific module</SPAN><br>    <SPAN style="color:#00007F">Dim</SPAN> rng <SPAN style="color:#00007F">As</SPAN> Range<br>        <SPAN style="color:#007F00">'   Set Target Range</SPAN><br>        Set rng = Target.Parent.Range("C4:C200")<br>             <SPAN style="color:#007F00">'   Only look at single cell changes</SPAN><br>            <SPAN style="color:#00007F">If</SPAN> Target.Count > 1 <SPAN style="color:#00007F">Then</SPAN> <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br>            <SPAN style="color:#007F00">'   Only look at that range</SPAN><br>            <SPAN style="color:#00007F">If</SPAN> Intersect(Target, rng) <SPAN style="color:#00007F">Is</SPAN> <SPAN style="color:#00007F">Nothing</SPAN> <SPAN style="color:#00007F">Then</SPAN> <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br>            <SPAN style="color:#007F00">'   Action if Condition(s) are met</SPAN><br>            <SPAN style="color:#00007F">Select</SPAN> <SPAN style="color:#00007F">Case</SPAN> Target.Text<br>                <SPAN style="color:#00007F">Case</SPAN> "C"<br>                    Target.EntireRow.Cut Sheets("Completed").Cells(Rows.Count, "A").End(xlUp).Offset(1)<br>                <SPAN style="color:#00007F">Case</SPAN> <SPAN style="color:#00007F">Is</SPAN> = ""<br>                    Target.EntireRow.Cut Sheets("To Do").Cells(Rows.Count, "A").End(xlUp).Offset(1)<br>            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Select</SPAN><br>End <SPAN style="color:#00007F">Sub</SPAN></FONT>

HTH,

 

[emjeff99]

See if this does what you want:

<font face=Tahoma><SPAN style="color:#00007F">Private</SPAN> <SPAN style="color:#00007F">Sub</SPAN> Workbook_SheetChange(<SPAN style="color:#00007F">ByVal</SPAN> Sh <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Object</SPAN>, <SPAN style="color:#00007F">ByVal</SPAN> Target <SPAN style="color:#00007F">As</SPAN> Range)<br>****<SPAN style="color:#007F00">'** Code goes in the Worksheet specific module</SPAN><br>****<SPAN style="color:#00007F">Dim</SPAN> rng <SPAN style="color:#00007F">As</SPAN> Range<br>********<SPAN style="color:#007F00">'** Set Target Range</SPAN><br>********Set rng = Target.Parent.Range("C4:C200")<br>************ <SPAN style="color:#007F00">'** Only look at single cell changes</SPAN><br>************<SPAN style="color:#00007F">If</SPAN> Target.Count > 1 <SPAN style="color:#00007F">Then</SPAN> <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br>************<SPAN style="color:#007F00">'** Only look at that range</SPAN><br>************<SPAN style="color:#00007F">If</SPAN> Intersect(Target, rng) <SPAN style="color:#00007F">Is</SPAN> <SPAN style="color:#00007F">Nothing</SPAN> <SPAN style="color:#00007F">Then</SPAN> <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br>************<SPAN style="color:#007F00">'** Action if Condition(s) are met</SPAN><br>************<SPAN style="color:#00007F">Select</SPAN> <SPAN style="color:#00007F">Case</SPAN> Target.Text<br>****************<SPAN style="color:#00007F">Case</SPAN> "C"<br>********************Target.EntireRow.Cut Sheets("Completed").Cells(Rows.Count, "A").End(xlUp).Offset(1)<br>****************<SPAN style="color:#00007F">Case</SPAN> <SPAN style="color:#00007F">Is</SPAN> = ""<br>********************Target.EntireRow.Cut Sheets("To Do").Cells(Rows.Count, "A").End(xlUp).Offset(1)<br>************<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Select</SPAN><br>End <SPAN style="color:#00007F">Sub</SPAN></FONT>

HTH,

So I'm a big dork - I know next to nothing when writing macros. Do I just paste this into one? (sorry)

 

[Smitty]

Right-click the Excel icon (next to the File menu). That will open the ThisWorkbook module. Paste the code in the new window that opens on the right.

The code will run automatically whenever the changes you wanted happen in either sheet. If you enter "C" in C4:C200 in the To Do sheet, the row will be cut and pasted into the Completed sheet. If you delete the "C" in that sheet it will be cut back.

 

[emjeff99]

Thank you!

 

[lall]

Hi,

I'm looking for similar macro that copies entire row from sheet2 to sheet5 if cell value in column R is "0" and then deletes the source(sheet2) rows that were copied.

 

[lall]

Sub moveZeroRows()
Dim X As Long
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
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
ActiveSheet.Cells(X, "R").EntireRow.Cut Destination:=Sheets("Sheet5").Range("A1:A" & LastRow)

Application.ScreenUpdating = True
End If
Next
End Sub

I made this..but as you can see it's made poorly..i'm noob you know..
I'll get error on

ActiveSheet.Cells(X, "R").EntireRow.Cut Destination:=Sheets("Sheet5").Range("A1:A" & LastRow)

And it's BLOODY slow..

 

[lall]

Sub test()

Dim x As Integer
x = 1
Application.ScreenUpdating = False
Do
If Cells(x, 18) = "0" Then 'Caps sensitive
Cells(x, 1).EntireRow.Copy
Sheets(5).Select
Cells(65000, 1).End(xlUp).Offset(0, 0).Select
ActiveSheet.Paste
Sheets(2).Select
End If
x = x + 1
Loop Until Cells(x, 1) = ""
Application.ScreenUpdating = True

End Sub

I tried to get this to work..
Actually it works. Slowly but faster than last. And it leaves copied rows still there, but how can i automatically remove them?

 

[lall]

So again.

This code is fast! But the problem is that it copies only the cell with 0 value, and leaves the source still. Now i'm really stuck and there is not coming more out of me..

Sub test()
Dim SourceSheet As Worksheet, destzero As Worksheet
Dim TotalRng As Range, zrow As Range
Dim destzerorow As Long
LastRow = Cells(Rows.Count, "A").End(xlUp).Row

Set SourceSheet = Worksheets("Sheet2")
Set destzero = Worksheets("Sheet5")

Set TotalRng = Range(SourceSheet.Range("R1"), SourceSheet.Range("R1:R" & LastRow))
destzerorow = 1

Application.ScreenUpdating = False
  For Each zrow In TotalRng
  Select Case Left(zrow, 1)
  
  Case "0"
    destzero.Cells(destzerorow, "A") = zrow
    destzerorow = destzerorow + 1

  Case Else
    Debug.Print "Error in sorting out 0 values from sheet!" & zrow.Address
  End Select
  Next
End Sub

So if someone could tell me, where is the mistake that takes cell instead of row and what to add, to get the row cut/pased not copied.

 

[lall]

Sub test()
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  For Each ce In Range("R1:R" & LastRow)
    Select Case ce.Value
      Case "0"
        Cells(ce.Row, "R").EntireRow.Cut Destination:=Sheets("Sheet5").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    End Select
  Next ce
End Sub

Can anyone tell me, why this code won't move second row from source sheet?
And why it leaves empty rows behind, and why it wont work..as it should be at all?