Using VBA to archive a row to a new sheet (task list sheet)

terraf

New Member
Joined
Sep 25, 2020
Messages
3
Office Version
  1. 365
Platform
  1. Windows
Hello
I am sorry if this has been asked before, I am a new member and also rather new to excel!
I have a spreadsheet with 8 tabs along the bottom all with 'to do list' type entries. I'd like to make a new tab at the end called 'archive' where I can store all rows with completed tasks in, removing them from the other 8 tabs but transferring the data to archive.
Each tab has 4 columns, the final one being named 'archive' with a drop down list of yes or no. If I choose 'yes' in the 4th column I would like the whole row to transfer to the archive sheet.
Can anyone suggest a code that would work for this?
Hugely appreciated :)
 

Some videos you may like

Excel Facts

When did Power Query debut in Excel?
Although it was an add-in in Excel 2010 & Excel 2013, Power Query became a part of Excel in 2016, in Data, Get & Transform Data.

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows
You can do that with change event code. Copy and paste the code below into the ThisWorkbook code module of your workbook. when you make changes on your To Do sheets, the code will run automatically and if there is a "Yes" in column D, it will remove that row from the To Do sheet and put it in the next available row of the Archive sheet.
VBA Code:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Sh.Name = "Archive" Then Exit Sub
Application.EnableEvents = False
    If Not Intersect(Target, Sh.Range("D:D")) Is Nothing Then
        If LCase(Target.Value) = "yes" Then
            Target.EntireRow.Cut Sheets("Archive").Cells(Rows.Count, 1).End(xlUp)(2)
        End If
    End If
Application.EnableEvents = True
End Sub
 

terraf

New Member
Joined
Sep 25, 2020
Messages
3
Office Version
  1. 365
Platform
  1. Windows
Thank you very much! I will give this a try today!
 

terraf

New Member
Joined
Sep 25, 2020
Messages
3
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

It works, thanks again! I think it is magic!

Is there any way to add something in to delete the empty row once the data has been transferred to the 'archive' sheet?

Huge thanks
 

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows
Use this modified version.
VBA Code:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Sh.Name = "Archive" Then Exit Sub
Dim r As Long
Application.EnableEvents = False
    If Not Intersect(Target, Sh.Range("D:D")) Is Nothing Then
    r = Target.Row
        If LCase(Target.Value) = "yes" Then
            Target.EntireRow.Cut Sheets("Archive").Cells(Rows.Count, 1).End(xlUp)(2)
            Rows(r).Delete
        End If
    End If
Application.EnableEvents = True
End Sub
 

Vavouyios

New Member
Joined
Nov 7, 2018
Messages
1
Use this modified version.
VBA Code:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Sh.Name = "Archive" Then Exit Sub
Dim r As Long
Application.EnableEvents = False
    If Not Intersect(Target, Sh.Range("D:D")) Is Nothing Then
    r = Target.Row
        If LCase(Target.Value) = "yes" Then
            Target.EntireRow.Cut Sheets("Archive").Cells(Rows.Count, 1).End(xlUp)(2)
            Rows(r).Delete
        End If
    End If
Application.EnableEvents = True
End Sub
Hi JLG,

This is great code! Can it be modified to do the same operation but instead take the row from a to-do list table and put it into another table (archive)? I tried running this code with tables and it properly removed and deleted it from the to-do list table and put it in the archive sheet but it put it below (or after) the archive table. Let me know if that is possible.

Best,
Alex
 

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows
See if this will work:

VBA Code:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Sh.Name = "Archive" Then Exit Sub
Dim r As Long, lr As ListRow
Application.EnableEvents = False
    If Not Intersect(Target, Sh.Range("D:D")) Is Nothing Then
    r = Target.Row
        If LCase(Target.Value) = "yes" Then
            Set lr = Sheets("Archive").ListObjects(1).ListRows.Add
            Target.EntireRow.Cut lr
            Rows(r).Delete
        End If
    End If
Application.EnableEvents = True
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,122,456
Messages
5,596,234
Members
414,048
Latest member
wnied1

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top