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?

 

[Desmondo]

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.

Hi Peter,

Thanks again for your reply. As i say i am completely new to this. When i try to insert the code, vba will normally indicate the first line the private sub as problem that's why i remove it. Otherwise when i copy the code it asks me to name the macro which i name archive and this seems to cause problems by highlighting that line so i delete as for changing other the changing of the range i initially thought that maybe i was to put the range of cells in there that i wanted changing. As i say this is completely new to me so i really appreciate your patience. What you describe is exactly what i need but does not seem to work. I have re-opened the 'To DO CODE' and inserted your code under module but still receive problems albeit different one as the first line



Sub Archive()
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

 

[Peter_SSs]

Desmondo

Try to follow these step EXACTLY

1. With a copy of your workbook open, press Alt+F11. That should open the vba window.

2. Locate your project in the left hand pane and click any + signs to open out your whole project.

3. If there is a 'Modules' folder it will most likely contain 'Module1'.
- If so, Right click on Module1 and choose 'Remove Module1...' Click 'No' to the question about exporting the Module.
- If there are other Modules, delete them too.
- If no Modules or no Modules folder go to the next step.

4. Still in the left hand pane, double click the Sheet that has (TO DO) beside it.

5. If there is any code in the right hand pane, delete it all.

6. Copy the code below and Paste it in the right hand pane where you just deleted the code from. That is, in the (TO DO) section.

7. Close the vba window and in the TO DO sheet itself, try entering Yes in one of the rows in column I. That row should disappear and reappear in the ARCHIVE sheet.

If you get any errors, please ..
- Record what the error message says
- Click Debug and note what line is highlighted yellow.
- Post back with those two bits of information.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Changed As Range
    
    Const YesCol As String = "I" '<- Your 'Yes' 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

 

[Peter_SSs]

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

There is no code in post #5. I assume you mean post #6?

Have data from row 8

Headings in row 8, or actual data in row 8 with headings in row 7, or something else?
Is there anything in row 1 in any column?

archive sheet is "Dead Deals"

What is the original data sheet called?

.. validation list in column O .. validation entries are "LIVE" or "DEAD"

.. and you want to move the row as soon as it says "DEAD"?

 

[Kempy]

Hi Peter, many thanks for your response.

Apologies if i got the post number wrong.

Headings are actually row 6 row 7 is a hidden row and actuall user inputted data is from row 8 down.

There is currently no data stored in row 1

The original data sheet is called "2013 Job Sheet"

Yes i would like to move the row when column O is changed to "DEAD"

Kind Regards

 

[Peter_SSs]

Hi Peter, many thanks for your response.

Apologies if i got the post number wrong.

Headings are actually row 6 row 7 is a hidden row and actuall user inputted data is from row 8 down.

There is currently no data stored in row 1

The original data sheet is called "2013 Job Sheet"

Yes i would like to move the row when column O is changed to "DEAD"

Kind Regards

Try this version in a copy of your workbook.
You would put this code in the '2013 Job Sheet' module (ie Right click '2013 Job Sheet' > View Code)

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Changed As Range
    Dim LastRow As Long
    
    Const DeadCol As String = "O" '<- Your 'Dead' column
    
    Set Changed = Intersect(Target, Columns(DeadCol))
    If Not Changed Is Nothing Then
        Application.EnableEvents = False
        Application.ScreenUpdating = False
        LastRow = Range("A" & Rows.Count).End(xlUp).Row
        With Range(DeadCol & "7:" & DeadCol & LastRow)
            .AutoFilter Field:=1, Criteria1:="=DEAD"
            With .Offset(1).EntireRow
                .Copy Destination:=Sheets("Dead Deals") _
                    .Range("A" & Rows.Count).End(xlUp).Offset(1)
                .Delete
            End With
            .AutoFilter
        End With
        Application.EnableEvents = True
        Application.ScreenUpdating = True
    End If
End Sub

 

[Desmondo]

Desmondo

Try to follow these step EXACTLY

1. With a copy of your workbook open, press Alt+F11. That should open the vba window.

2. Locate your project in the left hand pane and click any + signs to open out your whole project.

3. If there is a 'Modules' folder it will most likely contain 'Module1'.
- If so, Right click on Module1 and choose 'Remove Module1...' Click 'No' to the question about exporting the Module.
- If there are other Modules, delete them too.
- If no Modules or no Modules folder go to the next step.

4. Still in the left hand pane, double click the Sheet that has (TO DO) beside it.

5. If there is any code in the right hand pane, delete it all.

6. Copy the code below and Paste it in the right hand pane where you just deleted the code from. That is, in the (TO DO) section.

7. Close the vba window and in the TO DO sheet itself, try entering Yes in one of the rows in column I. That row should disappear and reappear in the ARCHIVE sheet.

If you get any errors, please ..
- Record what the error message says
- Click Debug and note what line is highlighted yellow.
- Post back with those two bits of information.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Changed As Range
    
    Const YesCol As String = "I" '<- Your 'Yes' 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,

I have tried exactly as you have instructed and it start's to run. I get a runtime error '1004' Application-defined or object-defined error. And debug shows this line
With Intersect(ActiveSheet.UsedRange, Columns(YesCol)).Offset(1) in yellow

 

[Peter_SSs]

I get a runtime error '1004' Application-defined or object-defined error. And debug shows this line
With Intersect(ActiveSheet.UsedRange, Columns(YesCol)).Offset(1) in yellow

That would make me think that you UsedRange goes right to the bottom of the worksheet. Does that seem right?

Just to confirm, have your TO DO sheet as the Active Sheet then in the vba window ensure the Immediate Window is visible (View > Immediate Window) and in the Immediate Window type the following and press Enter

?ActiveSheet.UsedRange.Address

What does that return?

In the meantime try the version below, but first we should check that your 'Events' have not been disabled in getting that error.
On a new line in the Immediate Window, type the following and press Enter
Application.EnableEvents=True

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Changed As Range
    Dim lr As Long
    
    Const YesCol As String = "I" '<- Your 'Yes' column
    
    Set Changed = Intersect(Target, Columns(YesCol))
    If Not Changed Is Nothing Then
        Application.EnableEvents = False
        Application.ScreenUpdating = False
        lr = Cells.Find(What:="*", After:=Cells(1, 1), LookIn:=xlValues, _
          SearchOrder:=xlByRows, SearchDirection:=xlPrevious, SearchFormat:=False).Row
        With Intersect(Rows("2:" & lr), Columns(YesCol))
            .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

 

[Desmondo]

That would make me think that you UsedRange goes right to the bottom of the worksheet. Does that seem right?

Just to confirm, have your TO DO sheet as the Active Sheet then in the vba window ensure the Immediate Window is visible (View > Immediate Window) and in the Immediate Window type the following and press Enter

?ActiveSheet.UsedRange.Address

What does that return?

In the meantime try the version below, but first we should check that your 'Events' have not been disabled in getting that error.
On a new line in the Immediate Window, type the following and press Enter
Application.EnableEvents=True

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Changed As Range
    Dim lr As Long
    
    Const YesCol As String = "I" '<- Your 'Yes' column
    
    Set Changed = Intersect(Target, Columns(YesCol))
    If Not Changed Is Nothing Then
        Application.EnableEvents = False
        Application.ScreenUpdating = False
        lr = Cells.Find(What:="*", After:=Cells(1, 1), LookIn:=xlValues, _
          SearchOrder:=xlByRows, SearchDirection:=xlPrevious, SearchFormat:=False).Row
        With Intersect(Rows("2:" & lr), Columns(YesCol))
            .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 the reply. The worksheet range does go all the way to the bottom that is correct.

the immediate window is the To Do sheet.

The code you have given me does do something it hides all of the data in the first sheet except the header and filter. but highlights a different error in debug, this is highlighted. Thanks again for your help

With .Offset(1).EntireRow

 

[Desmondo]

Hi Peter,

Thanks for the reply. The worksheet range does go all the way to the bottom that is correct.

the immediate window is the To Do sheet.

The code you have given me does do something it hides all of the data in the first sheet except the header and filter. but highlights a different error in debug, this is highlighted. Thanks again for your help

With .Offset(1).EntireRow

The usedcell range command shows the following in immediate window
Returns
$A:$J

 

[Peter_SSs]

The worksheet range does go all the way to the bottom that is correct.

Hmm, so you have a 'To Do' list that occupies 65,000+ (if using Excel 2003) or 1,000,000+ (if using Excel 2007+) rows? That should keep you busy for a while!!

I have no idea why you would be using so may rows for a 'To Do' list, but in any case try this version.
Again ensure that your Events have not been disabled.

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Changed As Range
  Dim lr As Long
  
  Const YesCol As String = "I" '<- Your 'Yes' column
  
  Set Changed = Intersect(Target, Columns(YesCol))
  If Not Changed Is Nothing Then
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    lr = Cells.Find(What:="*", After:=Cells(1, 1), LookIn:=xlValues, _
      SearchOrder:=xlByRows, SearchDirection:=xlPrevious, SearchFormat:=False).Row
    With Intersect(Rows("2:" & lr), Columns(YesCol))
      .AutoFilter Field:=1, Criteria1:="=YES"
      If .SpecialCells(xlVisible).Cells.Count > 1 Then
        With .Resize(.Rows.Count - 1).Offset(1).EntireRow
          .Copy Destination:= _
            Sheets("ARCHIVE").Range("A" & Rows.Count).End(xlUp).Offset(1)
          .Delete
        End With
      End If
      .AutoFilter
    End With
    Application.EnableEvents = True
    Application.ScreenUpdating = True
  End If
End Sub