Macro to Move Cells to Archive Sheet

[SpacemanSpif]

Hi there, longtime user firsttime poster. Looking for some help as I am a non-expert with macros. Here's what I'm trying to do:

We have to submit things to a certain regulatory body and we usually enter tasks in as soon as they come, do the submission, and then keep a record of that submission.

So, I have a workbook with two sheets, one is "TO DO", the other is "ARCHIVE". Both sheets have the same columns and everything. I am looking for a macro that will automatically cut a (row) from the TO DO sheet and paste it in into the ARCHIVE sheet once it is done, then delete the cut row from the TO DO list so it stays topped up.

The trigger for archiving is the columns M and N which are titled "Complete ?" and each has a validation drop down that says "YES". When both cells in columns M and N have the YES in them, I would like the macro to make the above mentioned actions.

I ran a search on the forums and found something similar, but not quite what I was looking for.

Any help?

 

[venkat1926]

main data in sheet "TO DO" is from A1 with no blank rows or columns
you have another sheet "ARCHIVES"

try this macro

Sub test()
Dim r As Range, filtr As Range
With Worksheets("TO DO")
Set r = .Range("A1").CurrentRegion
r.AutoFilter field:=.Range("M1").Column, Criteria1:="yes"
r.AutoFilter field:=.Range("N1").Column, Criteria1:="yes"
Set filtr = r.SpecialCells(xlCellTypeVisible)
'MsgBox filtr.Address
Set filtr = r.Offset(1, 0).Resize(r.Rows.Count - 1).SpecialCells(xlCellTypeVisible)

'MsgBox filtr.Address
filtr.Copy
With Worksheets("ARCHIVES")
.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial
End With
filtr.EntireRow.Delete
r.AutoFilter
End With
End Sub

 

[Peter_SSs]

Welcome to the MrExcel board!

You can make this happen automatically. Test in a copy of your workbook.

I have assumed that
a) data starts in column A and
b) that column A always has an entry in it by the time the two 'completed' columns are filled with 'YES'

To implement ...

1. Right click the 'TO DO' sheet name tab and choose "View Code".

2. Copy and Paste the code below into the main right hand pane that opens at step 1.

3. Close the Visual Basic window.

4. Try making changes in the sheet (especially columns M:N)


<font face=Courier New><br><SPAN style="color:#00007F">Private</SPAN> <SPAN style="color:#00007F">Sub</SPAN> Worksheet_Change(<SPAN style="color:#00007F">ByVal</SPAN> Target <SPAN style="color:#00007F">As</SPAN> Range)<br>    <SPAN style="color:#00007F">Dim</SPAN> Changed <SPAN style="color:#00007F">As</SPAN> Range<br>    <br>    <SPAN style="color:#00007F">Const</SPAN> YesCols <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN> = "M:N" <SPAN style="color:#007F00">'<- Your 'completed' columns</SPAN><br>    <br>    <SPAN style="color:#00007F">Set</SPAN> Changed = Intersect(Target, Columns(YesCols))<br>    <SPAN style="color:#00007F">If</SPAN> <SPAN style="color:#00007F">Not</SPAN> Changed <SPAN style="color:#00007F">Is</SPAN> <SPAN style="color:#00007F">Nothing</SPAN> <SPAN style="color:#00007F">Then</SPAN><br>        Application.EnableEvents = <SPAN style="color:#00007F">False</SPAN><br>        Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN><br>        <SPAN style="color:#00007F">With</SPAN> Intersect(ActiveSheet.UsedRange, Columns(YesCols))<br>            .AutoFilter Field:=1, Criteria1:="=YES"<br>            .AutoFilter Field:=2, Criteria1:="=YES"<br>            <SPAN style="color:#00007F">With</SPAN> .Offset(1).EntireRow<br>                .Copy Destination:=Sheets("ARCHIVE") _<br>                    .Range("A" & Rows.Count).End(xlUp).Offset(1)<br>                .Delete<br>            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>            .AutoFilter<br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>        Application.EnableEvents = <SPAN style="color:#00007F">True</SPAN><br>        Application.ScreenUpdating = <SPAN style="color:#00007F">True</SPAN><br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>

 

[SpacemanSpif]

Thanks guys this works like a charm! You're the best

 

[Desmondo]

Thanks guys this works like a charm! You're the best

This is something like what i have been trying to do with a spreadsheet for sometime. I have exactly the same name for my spread sheets. TO DO & ARCHIVE. I want to send my data to the archive based on the info in one column which is row column J when this has been changed to yes.

I am very new to macro's and this would save me so much time at my work, where i am currently pasting copying and deleting half of my day on an ever increasing work load. If someone could help me with this I would really appreciate it. My data start from A3 to J3 and has an max rows. Above those rows is headers and a tile.

 

[Peter_SSs]

This is something like what i have been trying to do with a spreadsheet for sometime. I have exactly the same name for my spread sheets. TO DO & ARCHIVE. I want to send my data to the archive based on the info in one column which is row column J when this has been changed to yes.

I am very new to macro's and this would save me so much time at my work, where i am currently pasting copying and deleting half of my day on an ever increasing work load. If someone could help me with this I would really appreciate it. My data start from A3 to J3 and has an max rows. Above those rows is headers and a tile.

Assuming your column J is not the result of a formula, you don't need many changes from the code posted above. Try this in a copy of your workbook. Implementation instructions in post #3.
Assumptions in post #3 also need to be true - post back with details if they are not.

<font face=Courier New><br><SPAN style="color:#00007F">Private</SPAN> <SPAN style="color:#00007F">Sub</SPAN> Worksheet_Change(<SPAN style="color:#00007F">ByVal</SPAN> Target <SPAN style="color:#00007F">As</SPAN> Range)<br>    <SPAN style="color:#00007F">Dim</SPAN> Changed <SPAN style="color:#00007F">As</SPAN> Range<br>    <br>    <SPAN style="color:#00007F">Const</SPAN> YesCol <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN> = "J" <SPAN style="color:#007F00">'<- Your 'completed' column</SPAN><br>    <br>    <SPAN style="color:#00007F">Set</SPAN> Changed = Intersect(Target, Columns(YesCol))<br>    <SPAN style="color:#00007F">If</SPAN> <SPAN style="color:#00007F">Not</SPAN> Changed <SPAN style="color:#00007F">Is</SPAN> <SPAN style="color:#00007F">Nothing</SPAN> <SPAN style="color:#00007F">Then</SPAN><br>        Application.EnableEvents = <SPAN style="color:#00007F">False</SPAN><br>        Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN><br>        <SPAN style="color:#00007F">With</SPAN> Intersect(ActiveSheet.UsedRange, Columns(YesCol)).Offset(1)<br>            .AutoFilter Field:=1, Criteria1:="=YES"<br>            <SPAN style="color:#00007F">With</SPAN> .Offset(1).EntireRow<br>                .Copy Destination:=Sheets("ARCHIVE") _<br>                    .Range("A" & Rows.Count).End(xlUp).Offset(1)<br>                .Delete<br>            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>            .AutoFilter<br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>        Application.EnableEvents = <SPAN style="color:#00007F">True</SPAN><br>        Application.ScreenUpdating = <SPAN style="color:#00007F">True</SPAN><br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br><br></FONT>

 

[Desmondo]

Assuming your column J is not the result of a formula, you don't need many changes from the code posted above. Try this in a copy of your workbook. Implementation instructions in post #3.
Assumptions in post #3 also need to be true - post back with details if they are not.


Private Sub Worksheet_Change(ByVal Target As Range)
****Dim Changed As Range
****
****Const YesCol As String = "J" '<- Your 'completed' column
****
****Set Changed = Intersect(Target, Columns(YesCol))
****If Not Changed Is Nothing Then
********Application.EnableEvents = False
********Application.ScreenUpdating = False
********With Intersect(ActiveSheet.UsedRange, Columns(YesCol)).Offset(1)
************.AutoFilter Field:=1, Criteria1:="=YES"
************With .Offset(1).EntireRow
****************.Copy Destination:=Sheets("ARCHIVE") _
********************.Range("A" & Rows.Count).End(xlUp).Offset(1)
****************.Delete
************End With
************.AutoFilter
********End With
********Application.EnableEvents = True
********Application.ScreenUpdating = True
****End If
End Sub

Hi Peter,

Thanks for your reply i have amended the sheet a little and it is now row I that contains the 'Yes' and this the final column of the book. I am doing this in excel 2003 as it's my work computers and they have not yet upgraded. I also have tidied up the sheet by hiding all teh unused columns if this makes a difference.

I have entered the code but i am getting errors. The code i have entered is as follows-

Sub Archive()
Const YesCol As String = "J" '<- Your 'completed' column

Set Changed = Intersect(Target, Columns(YesCol))
If Not Changed Is Nothing Then
Application.EnableEvents = False
Application.ScreenUpdating = False
With Intersect(ActiveSheet.UsedRange, Columns(YesCol)).Offset(1)
.AutoFilter Field:=1, Criteria1:="=Yes"
With .Offset(1).EntireRow
.Copy Destination:=Sheets("ARCHIVE") _
.Range("A" & Rows.Count).End(xlUp).Offset(1)
.Delete
End With
.AutoFilter
End With
Application.EnableEvents = True
Application.ScreenUpdating = True
End If
End Sub

i am getting errors however when i try to run it. Runtime error 424, object required?

As i say i am completely new to this, but find it very interesting. Hope you can help me further.

 

[Kempy]

Also would like to use this code but cannot get it to work (the automated code from post 5)

Have data from row 8 and column A:N validation list in column O, not all cells have data but always data in Col A.

validation entries are "LIVE" or "DEAD", archive sheet is "Dead Deals", same layout get a 1004 runt time error and it appears it doesnt like the following

With Intersect(ActiveSheet.UsedRange, Columns(YesCol)).Offset(1)


Any help greatly appreciated.

Kind Regards

 

[Desmondo]

Hi Peter,

Thanks for your reply i have amended the sheet a little and it is now row I that contains the 'Yes' and this the final column of the book. I am doing this in excel 2003 as it's my work computers and they have not yet upgraded. I also have tidied up the sheet by hiding all teh unused columns if this makes a difference.

I have entered the code but i am getting errors. The code i have entered is as follows-

Sub Archive()
Const YesCol As String = "J" '<- Your 'completed' column

Set Changed = Intersect(Target, Columns(YesCol))
If Not Changed Is Nothing Then
Application.EnableEvents = False
Application.ScreenUpdating = False
With Intersect(ActiveSheet.UsedRange, Columns(YesCol)).Offset(1)
.AutoFilter Field:=1, Criteria1:="=Yes"
With .Offset(1).EntireRow
.Copy Destination:=Sheets("ARCHIVE") _
.Range("A" & Rows.Count).End(xlUp).Offset(1)
.Delete
End With
.AutoFilter
End With
Application.EnableEvents = True
Application.ScreenUpdating = True
End If
End Sub

i am getting errors however when i try to run it. Runtime error 424, object required?

As i say i am completely new to this, but find it very interesting. Hope you can help me further.

From my own pc with excel 2010 i get the following error

Compile error constant expression required on this line of code Set Changed = Intersect(Target, Columns(YesCol))

Maybe this helps

 

[Peter_SSs]

Hi Peter,

Thanks for your reply i have amended the sheet a little and it is now row I that contains the 'Yes' and this the final column of the book. I am doing this in excel 2003 as it's my work computers and they have not yet upgraded. I also have tidied up the sheet by hiding all teh unused columns if this makes a difference.

I have entered the code but i am getting errors. The code i have entered is as follows-

Sub Archive()
Const YesCol As String = "J" '<- Your 'completed' column

Set Changed = Intersect(Target, Columns(YesCol))
If Not Changed Is Nothing Then
Application.EnableEvents = False
Application.ScreenUpdating = False
With Intersect(ActiveSheet.UsedRange, Columns(YesCol)).Offset(1)
.AutoFilter Field:=1, Criteria1:="=Yes"
With .Offset(1).EntireRow
.Copy Destination:=Sheets("ARCHIVE") _
.Range("A" & Rows.Count).End(xlUp).Offset(1)
.Delete
End With
.AutoFilter
End With
Application.EnableEvents = True
Application.ScreenUpdating = True
End If
End Sub

i am getting errors however when i try to run it. Runtime error 424, object required?

As i say i am completely new to this, but find it very interesting. Hope you can help me further.

Desmondo

My code is designed to move the rows from TO DO to ARCHIVE immediately the relevant column is changed to "yes". If you don't want that, that is you want to wait and manually trigger the cleanup of rows to ARCHIVE, then please post back to say so & I will suggest some alternative code.

Assuming you want it to happen immediately (which is what was happening originally in this thread) then ..

a) You must not change the first line from Private Sub Worksheet_Change(ByVal Target As Range)

b) The code must be placed in the TO DO worksheet module. I'm not sure if you have done that or not but if you follow the implementation steps 1 & 2 I outlined in post #3 the code will be in the right place.

c) If the "Yes" values are now in column I all you need to change is the red "J" that I have highlighted in your above to "I"

Depending on your vba settings it may not stop the code from running, but I'm wondering why you also removed the Dim Changed As Range line from my code.