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?

 

[Peter_SSs]

I have tried using this code but when I enter YES in column E (I have changed from J to E in code) the row Which I want to cut from "TO DO" and move in "ARCHIVE" sheet remains in the same 'TO DO' sheet and all other rows are moving and hiding in 'ARCHIVE' sheet. Can you please help me. I Can send my excel but looks like this forum is not allowed excel.

There were a number of assumptions in and leading up to that post. Those assumptions may not be correct for your sheet, so let's clarify your position.

1. Please give a clear description of what rows/columns you have and what row contains headings, if there are headings.
2. Does the "TO DO" sheet have an entry in column A for every row that will be moved to "ARCHIVE"?

You cannot attach workbooks in the forum, but you can post small screen shots. Look here

 

[Krishna_5592589]

There were a number of assumptions in and leading up to that post. Those assumptions may not be correct for your sheet, so let's clarify your position.

1. Please give a clear description of what rows/columns you have and what row contains headings, if there are headings.
2. Does the "TO DO" sheet have an entry in column A for every row that will be moved to "ARCHIVE"?

You cannot attach workbooks in the forum, but you can post small screen shots. Look here

I have 5 columns that are A.Date, B.Activity/Task/Item, C.Reference, D.Comments, E.Archive. I have data in A and B columns mandatorily CDE are optional. I want as and when I type in the column E as YES, I want excel to cut the row from "TO DO" sheet and paste it to "ARCHIVE". Ex: Row no 1 are headings so data starts with row number 2. I have data in row number 2,3,4 and I enter YES in E2 then the entire row should automatically cut from "TO DO" and paste in "ARCHIVE" sheet.

Request you to please help me

 

[Peter_SSs]

I have 5 columns that are A.Date, B.Activity/Task/Item, C.Reference, D.Comments, E.Archive. I have data in A and B columns mandatorily CDE are optional. I want as and when I type in the column E as YES, I want excel to cut the row from "TO DO" sheet and paste it to "ARCHIVE". Ex: Row no 1 are headings so data starts with row number 2. I have data in row number 2,3,4 and I enter YES in E2 then the entire row should automatically cut from "TO DO" and paste in "ARCHIVE" sheet.

Thanks for the clear descriptions. The issue is that the code you tried to use was for somebody whose data started in row 3, not row 2 like yours.

So, as well as changing the "J" to "E", you also need to remove this

With Intersect(ActiveSheet.UsedRange, Columns(YesCol))<del>.Offset(1)</del>

 

[rtaylor522]

Hi, I have been following this thread and was using a version of your code to do a simple IPAD inventory sheet. I have decided to make some changes, and am hung up (very new at this) on how to do it. I have "Sheet1" and "Sheet2". Sheet 1 is the current log of who has the iPads. Columns A-F are utilized tracking information with Column F saying "Condition OK?" If "YES" is entered, I would like a Macro button that would recognize the "YES" and move the appropriate Rows to "Sheet2" which is the Archive Log of who had them and for what dates. It's formatting mirrors Sheet 1.

The second hang up I am encountering is that when it copy's and delete's the Row, it deletes the entire Row, I only want Cells C-G Cleared. A&B must remain because they are the iPad's tracking numbers and barcode.


Can you help me with this?
Thank you for your time!

Rob

 

[Peter_SSs]

Welcome to the MrExcel board!

As mentioned early in the thread, this can happen automatically rather than requiring a button to instigate the action.
Post #3 describes how to implement this Worksheet_Change code only you will use 'Sheet1' where that instruction uses 'TO DO'.
If you really do want a button then a slight variation of this code could be used.

Test in a copy of your workbook with this code.

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Changed As Range
  
  Const YesCol As String = "F" '<- 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))
      .AutoFilter Field:=1, Criteria1:="=YES"
      With .Offset(1).EntireRow
        .Copy Destination:=Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
        .Resize(, 5).Offset(, 2).ClearContents
      End With
      .AutoFilter
    End With
    Application.EnableEvents = True
    Application.ScreenUpdating = True
  End If
End Sub

 

[rtaylor522]

Peter,
This worked perfectly. I'm trying to compare my old code to find out where I went wrong. What portion of this code makes it transfer just the designated cells in the row vs. the entire row, so I can change that if I want?

Also if I wanted to include a button to prevent someone else using the spreadsheet from accidentally archiving the row prematurely what would I do?

I have been moved to an office position recently, and I had no idea you could do this stuff on excel. Can you recommend a good book to get started with so I don't feel like I'm having you do my work for me?

Your time is greatly appreciated!
Rob

Welcome to the MrExcel board!

As mentioned early in the thread, this can happen automatically rather than requiring a button to instigate the action.
Post #3 describes how to implement this Worksheet_Change code only you will use 'Sheet1' where that instruction uses 'TO DO'.
If you really do want a button then a slight variation of this code could be used.

Test in a copy of your workbook with this code.

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Changed As Range
  
  Const YesCol As String = "F" '<- 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))
      .AutoFilter Field:=1, Criteria1:="=YES"
      With .Offset(1).EntireRow
        .Copy Destination:=Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
        .Resize(, 5).Offset(, 2).ClearContents
      End With
      .AutoFilter
    End With
    Application.EnableEvents = True
    Application.ScreenUpdating = True
  End If
End Sub

 

[Peter_SSs]

What portion of this code makes it transfer just the designated cells in the row vs. the entire row, so I can change that if I want?

The code does transfer the entire row to Sheet2, so I'm not quite sure what you are really asking here.

Also if I wanted to include a button to prevent someone else using the spreadsheet from accidentally archiving the row prematurely what would I do?

You would remove that previous code and include the code below in a standard module and have your button run this macro.

Sub MoveYesToArchive()
  Const YesCol As String = "F" '<- Your 'YES' column
  
  Application.ScreenUpdating = False
  With Intersect(ActiveSheet.UsedRange, Columns(YesCol))
    .AutoFilter Field:=1, Criteria1:="=YES"
    With .Offset(1).EntireRow
      .Copy Destination:=Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
      .Resize(, 5).Offset(, 2).ClearContents
    End With
    .AutoFilter
  End With
  Application.ScreenUpdating = True
End Sub

Can you recommend a good book to get started with so I don't feel like I'm having you do my work for me?

I didn't use books, I learnt most of what I know right here in the forum.

 

[rtaylor522]

I see what you mean,
How did you get it to copy the whole row, but leave the first 2 columns on alone on the original sheet (i.e. Columns A&B on Sheet 1 never change)

The code does transfer the entire row to Sheet2, so I'm not quite sure what you are really asking here.



You would remove that previous code and include the code below in a standard module and have your button run this macro.

Sub MoveYesToArchive()
  Const YesCol As String = "F" '<- Your 'YES' column
  
  Application.ScreenUpdating = False
  With Intersect(ActiveSheet.UsedRange, Columns(YesCol))
    .AutoFilter Field:=1, Criteria1:="=YES"
    With .Offset(1).EntireRow
      .Copy Destination:=Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
      .Resize(, 5).Offset(, 2).ClearContents
    End With
    .AutoFilter
  End With
  Application.ScreenUpdating = True
End Sub

I didn't use books, I learnt most of what I know right here in the forum.

 

[Peter_SSs]

How did you get it to copy the whole row, but leave the first 2 columns on alone on the original sheet (i.e. Columns A&B on Sheet 1 never change)

.Resize(, 5).Offset(, 2).ClearContents

The line above says that for any (complete) row(s) already copied to Sheet 2 ..

Resize to only use 5 columns instead of the entire row. That would be columns A:E
Now offset 2 columns to the right. That would now be columns C:G
Clear what is in those cells

 

[shejeer]

Hi Peter,

Your VBA code is working great. I need a small change which I can not do myself. The current VBA code is moving the entire row from TO DO to ARCHIVE sheet. I want only move upto AE only (specific range instead of entire row). Could you please help. the current macro is given below :-

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Changed As Range
Dim LastRow As Long

Const DeadCol As String = "AE" '<- Your 'Dead' column

' first part to archive the data

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 & "5:" & DeadCol & LastRow)
.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