Copy/paste rows based on today's date

[SushiJuice]

Hello,

Long time fan of the YouTube channel, but first time posting here. I've implemented a lot of ideas from info gained from the shows, but I'm really green when it comes to VBA.

I'm trying to copy rows from Sheet 1 to Sheet 2 as an archive system so Sheet 2 would continually add more data as time goes on; essentially copying any rows with dates on or before today and pasting them into Sheet 2

The date column is H:H and pasting entire row to Sheet 2.

Please help

 

[SushiJuice]

It looks like the top row with Optional is causing the error, when I insert a blank row A2:G2 so there is a gap between Optional and your table the macro works for me.

Sorry, still having issues.

I inserted a blank row at A2:G2 and I still get the error.

I completely deleted the the row with the "Optional" in it, and the blank row below it so all the column headers are in row 1, and I still get the error.

Is there any way you can attach the file you're using so I can take a look at it?

 

[RasGhul]

Unfortunately I think there are rules against uploading sheets to the site hence why we use XL2BB to paste

Ok I've now placed the Thaw Date and Thaw date formula onto Sheet2 where your archive data is being saved like the following, note that the macro has also changed slightly;

Sub RectangleRoundedCorners1_Click()

Dim rg As Range
Set rg = ThisWorkbook.Worksheets("Sheet2").Range("A1").CurrentRegion

rg.Offset(1).ClearContents

Dim rgdata As Range, rgcriteria As Range, rgOutput As Range

Set rgdata = ThisWorkbook.Worksheets("Sheet1").Range("A4").CurrentRegion
    Set rgcriteria = ThisWorkbook.Worksheets("Sheet2").Range("I1").CurrentRegion
Set rgOutput = ThisWorkbook.Worksheets("Sheet2").Range("A1").CurrentRegion

rgdata.AdvancedFilter xlFilterCopy, rgcriteria, rgOutput

End Sub

Copy - paste rows based on today's date SushiJuice.xlsm
	A	B	C	D	E	F	G
1	Cut date	Item	Salerep	Thaw Weight	Child	Child Weight	Thaw Date
2	21/01/2022	Halibut 40/u p	Adam M (388)	35			21/01/2022
3	23/01/2022	Halibut 40/u p	Ellen Jones (323)	300			23/01/2022
4	24/01/2022	Halibut U/20	Adam M (388)	20			22/01/2022
5	24/01/2022	Halibut 40/u p	Adam M (388)	70			24/01/2022
6	24/01/2022	Sablefish 7/u p	Adam M (388)	10			23/01/2022
7	22/01/2022	Halibut U/20	Mike M (321)	450			22/01/2022
8	25/01/2022	Halibut 40/u p	Ellen Jones (323)	300			25/01/2022
9	24/01/2022	C/R Sockeye	Ellen Jones (323)	50			24/01/2022
10	27/01/2022	Halibut 40/u p	Ellen Jones (323)	300			27/01/2022
11	19/01/2022	Halibut 40/u p	Adam M (388)	35			19/01/2022
12	23/01/2022	Halibut 40/u p	Ellen Jones (323)	300			17/01/2022
13	24/01/2022	Halibut U/20	Adam M (388)	20			15/01/2022
14	24/01/2022	Halibut 40/u p	Adam M (388)	70			13/01/2022
15	24/01/2022	Sablefish 7/u p	Adam M (388)	10			11/01/2022
16	22/01/2022	Halibut U/20	Mike M (321)	450			9/01/2022
17	25/01/2022	Halibut 40/u p	Ellen Jones (323)	300			7/01/2022
18	24/01/2022	C/R Sockeye	Ellen Jones (323)	50			5/01/2022
19	27/01/2022	Halibut 40/u p	Ellen Jones (323)	300			3/01/2022
Sheet1

Copy - paste rows based on today's date SushiJuice.xlsm
	A	B	C	D	E	F	G	H	I
1	Cut date	Item	Salerep	Thaw Weight	Child	Child Weight	Thaw Date		Thaw Date
2	21/01/2022	Halibut 40/u p	Adam M (388)	35			21/01/2022		<=44589
3	23/01/2022	Halibut 40/u p	Ellen Jones (323)	300			23/01/2022
4	24/01/2022	Halibut U/20	Adam M (388)	20			22/01/2022
5	24/01/2022	Halibut 40/u p	Adam M (388)	70			24/01/2022
6	24/01/2022	Sablefish 7/u p	Adam M (388)	10			23/01/2022
7	22/01/2022	Halibut U/20	Mike M (321)	450			22/01/2022
8	25/01/2022	Halibut 40/u p	Ellen Jones (323)	300			25/01/2022
9	24/01/2022	C/R Sockeye	Ellen Jones (323)	50			24/01/2022
10	27/01/2022	Halibut 40/u p	Ellen Jones (323)	300			27/01/2022
11	19/01/2022	Halibut 40/u p	Adam M (388)	35			19/01/2022
12	23/01/2022	Halibut 40/u p	Ellen Jones (323)	300			17/01/2022
13	24/01/2022	Halibut U/20	Adam M (388)	20			15/01/2022
14	24/01/2022	Halibut 40/u p	Adam M (388)	70			13/01/2022
15	24/01/2022	Sablefish 7/u p	Adam M (388)	10			11/01/2022
16	22/01/2022	Halibut U/20	Mike M (321)	450			9/01/2022
17	25/01/2022	Halibut 40/u p	Ellen Jones (323)	300			7/01/2022
18	24/01/2022	C/R Sockeye	Ellen Jones (323)	50			5/01/2022
19	27/01/2022	Halibut 40/u p	Ellen Jones (323)	300			3/01/2022
Sheet2

Cell Formulas
Range	Formula
I2	I2	="<="&TODAY()

 

[SushiJuice]

Ok I no longer get the error! Great!!

But it partially works - the data gets transferred over to the archive, but the rows still remain on the original sheet. Is there a way to delete the rows once they're transferred?

thanks so much for your help so far

 

[RasGhul]

Ok I no longer get the error! Great!!

But it partially works - the data gets transferred over to the archive, but the rows still remain on the original sheet. Is there a way to delete the rows once they're transferred?

thanks so much for your help so far

Updated code to delete data from Sheet1 after transfer, note that dates after todays date remain in Sheet1.

Dim rg As Range
Set rg = ThisWorkbook.Worksheets("Sheet2").Range("A1").CurrentRegion

Application.ScreenUpdating = False
' Delete existing archive
    rg.Offset(1).ClearContents

Dim rgdata As Range, rgcriteria As Range, rgOutput As Range

Set rgdata = ThisWorkbook.Worksheets("Sheet1").Range("A4").CurrentRegion
    Set rgcriteria = ThisWorkbook.Worksheets("Sheet2").Range("I1").CurrentRegion
Set rgOutput = ThisWorkbook.Worksheets("Sheet2").Range("A1").CurrentRegion

' Filter & Copy to Sheet2
    rgdata.AdvancedFilter xlFilterCopy, rgcriteria, rgOutput

' Filter and Delete
rgdata.AdvancedFilter xlFilterInPlace, rgcriteria
    rgdata.Offset(1).ClearContents
    ThisWorkbook.Worksheets("Sheet1").ShowAllData
Application.ScreenUpdating = True

 

[vcoolio]

Hello SushiJuice,

Just automating the AutoFilter should work for you:-

Sub Test()

Application.ScreenUpdating = False

        With Sheet1.[A1].CurrentRegion
                .AutoFilter 7, "<=" & [Today()]
                .Offset(1).EntireRow.Copy Sheet2.Range("A" & Rows.Count).End(3)(2)
                .Offset(1).EntireRow.Delete
                .AutoFilter
        End With
        
Sheet2.Columns.AutoFit
Application.ScreenUpdating = True

End Sub

I'm assuming that your data does actually start in Column A with headings in row1 which means that the thaw dates are in Column G.
I've use the sheet codes in the macro, not the sheet names.
Assign the code to a button.

I hope that this helps.

Cheerio,
vcoolio.

 

[SushiJuice]

Updated code to delete data from Sheet1 after transfer, note that dates after todays date remain in Sheet1.

Dim rg As Range
Set rg = ThisWorkbook.Worksheets("Sheet2").Range("A1").CurrentRegion

Application.ScreenUpdating = False
' Delete existing archive
    rg.Offset(1).ClearContents

Dim rgdata As Range, rgcriteria As Range, rgOutput As Range

Set rgdata = ThisWorkbook.Worksheets("Sheet1").Range("A4").CurrentRegion
    Set rgcriteria = ThisWorkbook.Worksheets("Sheet2").Range("I1").CurrentRegion
Set rgOutput = ThisWorkbook.Worksheets("Sheet2").Range("A1").CurrentRegion

' Filter & Copy to Sheet2
    rgdata.AdvancedFilter xlFilterCopy, rgcriteria, rgOutput

' Filter and Delete
rgdata.AdvancedFilter xlFilterInPlace, rgcriteria
    rgdata.Offset(1).ClearContents
    ThisWorkbook.Worksheets("Sheet1").ShowAllData
Application.ScreenUpdating = True

The new macro just deleted all of my data.

At this point I'm giving up.

Thanks for your help