Move Row(s) Based On Today's Date

[ccm123]

Hi,

Totally new to using VBA but really need a script to be able to do the following:

I have a sheet named "Calendar" that has a row for each day of the year in order to plan and prepare social media posts for specific days. I have a second sheet named "Archive" where I would like the already posted days to move, ergo I need a script to check the date against the date in the first sheet's column C and if it is a date that has already passed then cut and paste the whole row to the Archive sheet.

I have scoured forums and sites online and played around with some solutions that have helped people with similar queries to no avail, so would greatly appreciate it if someone could help me out.

 

[rpaulson]

try this on a copy of your file

Sub move_it()

Dim rs As Worksheet
Set rs = Worksheets("Archive")
lr = Cells(Rows.Count, "A").End(xlUp).Row

For r = 2 To lr

If Cells(r, "C") < [C1] Then
    wr = rs.Cells(Rows.Count, "A").End(xlUp).Row + 1
    Rows(r).Cut Destination:=rs.Range("A" & wr)
End If

Next r
End Sub

hth,
Ross

 

[mumps]

Try this macro. It assumes that you have headers in row 1 of the "Calendar" sheet and that the data starts in row 2.

Sub MoveRows()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Sheets("Calendar").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Sheets("Archive").UsedRange.ClearContents
    Sheets("Calendar").Range("C1:C" & LastRow).AutoFilter Field:=1, Criteria1:="<" & Date
    Sheets("Calendar").Range("C2:C" & LastRow).SpecialCells(xlCellTypeVisible).EntireRow.Copy Sheets("Archive").Cells(1, 1)
    Sheets("Calendar").Range("C2:C" & LastRow).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    If Sheets("Calendar").AutoFilterMode Then Sheets("Calendar").AutoFilterMode = False
End Sub

 

[ccm123]

Hi,

Thanks so much for your help. I'm getting an error ('We can't do this to a merged cell') - based on some of the limitations with merged cells I've run into in the past I'm going to assume it is not possible to do this to a merged cell at all? Have attached a screenshot of the ideal setup so you can get an idea.

This macro is, however, doing the trick when I make the file with no merged cells which is great! Thank you a lot.

 

[ccm123]

Forgot to add the image, oops! Here it is.

https://imgur.com/a/L54Mbm2

 

[ccm123]

Hi,

Thanks for your help! When I tried this, it moved the entire 'Calendar' sheet to the 'Archive' sheet and then was giving the error along the lines of no cells found. In any case, thanks for taking the time to help but I have found a solution thanks to Ross' answer above.