Forum Discussion
Solved
Macro/VBA to move + delete entries based on date
Hey!
I haven't been able to figure this out for about a week now. I have a sheet for work that is used to check if clients have visited within the past two weeks. I would like to move rows over 14 days old to another sheet on the same file and then delete those same entries from the main sheet. The dates are stored in column a formatted as dd.mm.yyyy. I would ideally like to only move columns a-i, because columns j and k have data that doesn't need to be carried over, but if that is more trouble than it is worth the whole row is fine.
I also am not super familiar with running Macros/VBAs and am wondering if it runs each time the sheet is opened?
Any help is greatly appreciated!
Sub fourteendays() Dim ws As Worksheet Dim ws1 As Worksheet Dim lastrow As Long Dim i As Long Dim k As Long Dim todaydate As Date todaydate = Date Set ws = Worksheets("Tabelle1") Set ws1 = Worksheets("Tabelle2") k = ws1.Cells(Rows.Count, 1).End(xlUp).Row lastrow = ws.Cells(Rows.Count, 1).End(xlUp).Row For i = 2 To lastrow If Cells(i, 1).Value <> "" Then If Cells(i, 1).Value < todaydate - 14 Then ws.Range("A" & i, "I" & i).Copy Destination:=ws1.Range("A" & k + 1) k = k + 1 ws.Rows(i).Delete i = i - 1 Else End If Else End If Next i Application.CutCopyMode = False End SubMaybe with these lines of code. In the attached file you can click the button in cell N2 to run the macro. The dates are in column A of sheet "Tabelle1" and in column B to K are random numbers for this example.
Sub fourteendays() Dim ws As Worksheet Dim ws1 As Worksheet Dim lastrow As Long Dim i As Long Dim k As Long Dim todaydate As Date todaydate = Date Set ws = Worksheets("Tabelle1") Set ws1 = Worksheets("Tabelle2") k = ws1.Cells(Rows.Count, 1).End(xlUp).Row lastrow = ws.Cells(Rows.Count, 1).End(xlUp).Row For i = 2 To lastrow If Cells(i, 1).Value <> "" Then If Cells(i, 1).Value < todaydate - 14 Then ws.Range("A" & i, "I" & i).Copy Destination:=ws1.Range("A" & k + 1) k = k + 1 ws.Rows(i).Delete i = i - 1 Else End If Else End If Next i Application.CutCopyMode = False End SubMaybe with these lines of code. In the attached file you can click the button in cell N2 to run the macro. The dates are in column A of sheet "Tabelle1" and in column B to K are random numbers for this example.
OliverScheurich This is great. Is there a way to do this exact thing except have the final destination be a worksheet in another workbook instead?
Change the line
Set ws1 = Worksheets("Tabelle2")to
Set ws1 = Workbooks("OtherWorkbook.xlsx").Worksheets("OthwerWorksheet")substituting the correct names, of course.
- worked perfectly once I converted the dates back to US format, thanks a ton !
I'd leave all data on the one sheet, and use a filter on the date column to show or hide rows as needed.
- I don't think this would work in my situation because I have a function that uses the entries on the sheet to check whether a client has come in the last few weeks. So, I need the one main sheet to only have two weeks worth of entries
