Macro to move row to another worksheet

emjeff99

Board Regular
Joined
Feb 16, 2006
Messages
55
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!!!
 

Some videos you may like

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop

Smitty

Legend
Joined
May 15, 2003
Messages
29,536
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

Board Regular
Joined
Feb 16, 2006
Messages
55
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

Legend
Joined
May 15, 2003
Messages
29,536
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

Board Regular
Joined
Feb 16, 2006
Messages
55

ADVERTISEMENT

Thank you!
 

lall

Board Regular
Joined
Sep 19, 2008
Messages
195
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

Board Regular
Joined
Sep 19, 2008
Messages
195

ADVERTISEMENT

Code:
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

Code:
ActiveSheet.Cells(X, "R").EntireRow.Cut Destination:=Sheets("Sheet5").Range("A1:A" & LastRow)
And it's BLOODY slow..
 

lall

Board Regular
Joined
Sep 19, 2008
Messages
195
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

Board Regular
Joined
Sep 19, 2008
Messages
195
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..
Code:
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

Board Regular
Joined
Sep 19, 2008
Messages
195
Code:
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?
 

Watch MrExcel Video

Forum statistics

Threads
1,109,183
Messages
5,527,289
Members
409,757
Latest member
uzamr

This Week's Hot Topics

Top