Select/Move Rows to New Sheet Based on Date

[cb977]

Hi,

So I have spent considerable time trying to find a way to move ENTIRE rows from one worksheet to another, If the value in the "Date" column is in the past. Unfortunately I can't put up a copy of any of my attempts as I have since deleted them, but so for I've tried: Selecting rows and cut/copying them (I managed to select the rows, but Excel can't cut with a multi selection), then I tried to iteratively select/move rows and I could select and cut the rows but was using pastespecial on a range and it wouldn't work, then I tried to filter the data (to get all the rows with past dates together) instead of selecting it, I could get it to filter and select it but again the paste wasn't working (also that didn't work ideally as I am already using a filter across a row and doing it that way moved the filter). I've also tried stitching other code from this and other forums, lots of people have asked how to do similar things, but with no success.

I have a screenshot of my current set up, but can't post it as I need a post count greater than 5 :'( Basically I have 12 columns, headers are in rows A and B (so obviously I don't want to ever select those), one header is date.

I am trying to get it so that all the rows that have dates in the past (expired licences) are moved to another sheet so I don't have a cluttered workbook but I don't lose the information in case people need their old licence numbers or we are audited and they ask for a past licence.

Already eternally grateful for any help,

-C

[cb977]

puu.sh/lGtIq/5214d7f5e2.png <--- that's the screenshot of my layout
mrexcel.com/forum/excel-questions/685493-visual-basic-applications-move-rows-another-sheet-based-criteria.html
That was one such example I have tried modifying without success (had to remove www to post)

[Charlize]

Take a look at this kb for some inspiration with dates. You can hide the rows you don't want to see if a date is less than today.
http://www.vbaexpress.com/kb/getarticle.php?kb_id=923
Instead of B1 use F2 for the autofilter (F2 = header of column licence dates)
Charlize

[cb977]

Thanks for the quick reply, but I actually NEED the expired licences moved to another sheet,that's the problem. I can filter them out just fine but I was told it's not enough

Take a look at this kb for some inspiration with dates. You can hide the rows you don't want to see if a date is less than today.
.vbaexpress.com/kb/getarticle.php?kb_id=923
Instead of B1 use F2 for the autofilter (F2 = header of column licence dates)
Charlize

[Charlize]

This coding, with some adaptation on your side, will do the trick. Try it first on some bogus file to be sure.
You need to find the column that holds the expiry license. Then the last column you use in your setup.

Sub copy_visible_rows()
'variable for your workbook
Dim mywb As Workbook
'destination worksheet
Dim wsdest As Worksheet
'initial data Worksheet
Dim wsstart As Worksheet
'no of rows in wsstart before filtering
Dim mylrow As Long


'declare as date
Dim dDate As Date
'declare as long (using numbering of excel for dates)
Dim lDate As Long
'store today in datevariabele
dDate = DateSerial(Year(Now), Month(Now), Day(Now))
'save as number
lDate = dDate


'define the holder mywb
Set mywb = ActiveWorkbook
'define the destination = archive for expired licenses
'named Archive = a sheet with the name Archive must exist
Set wsdest = mywb.Worksheets("Archive")
'the initial startsheet with all the data is sheet you look at
'when you start this macro
Set wsstart = mywb.ActiveSheet


'count no of rows where F = column of licenses
mylrow = wsstart.Range("F" & Rows.Count).End(xlUp).Row
'set the alerts for deleting visible filtered rows = expired licenses off
Application.DisplayAlerts = False
'with starting sheet
With wsstart
    'set filtermode on
    If .AutoFilterMode = False Then
        'turn autofilter on
        'field:=6 = count no of columns until date field is located
        'F = column 6 a = 1
        .Range("F1").AutoFilter field:=6, Criteria1:="<" & lDate
        'copy a2 to n & lastrow with special bonus only visible filtered rows
        'and place them to destination sheet a row below the lowest row
        'if destination sheet has row 6 filled in column A then the offset
        'row will be used to start
        .Range("A2:N" & mylrow).SpecialCells(xlCellTypeVisible).Copy _
            wsdest.Range("A" & wsdest.Range("A" & Rows.Count).End(xlUp).Row).Offset(1)
        'remove the copied selection to archive from initial startsheet
        .Range("A2:N" & mylrow).SpecialCells(xlCellTypeVisible).Delete
        'turn autofilter off
        .Range("F1").AutoFilter
    Else
        MsgBox ("Turn autofilter of before archiving."), vbInformation
    End If
End With
'restore the alerts of excel
Application.DisplayAlerts = True
End Sub

Charlize

[cb977]

Hey Charlize,

I only just got this reply now after I'd already figured out a solution. I didn't try your code, this was what I ended up writing that got the job done:
Private Sub CommandButton2_Click()
ActiveSheet.Unprotect Password:="admin"
Sheets("Expired Licences").Unprotect Password:="admin"
Dim lr As Long
Dim lr2 As Long
Dim r As Long
lr = Sheets("Current Licences").Cells(rows.Count, "A").End(xlUp).Row
lr2 = Sheets("Expired Licences").Cells(rows.Count, "A").End(xlUp).Row
For r = lr To 2 Step -1
If Range("F" & r).Value < Now() Then
rows(r).Cut Destination:=Sheets("Expired Licences").Range("A" & lr2 + 1)
rows(r).Delete
lr2 = Sheets("Expired Licences").Cells(rows.Count, "A").End(xlUp).Row
End If
Next r
ActiveSheet.EnableAutoFilter = True
ActiveSheet.Protect Contents:=True, Password:="admin", AllowFiltering:=True
Sheets("Expired Licences").EnableAutoFilter = True
Sheets("Expired Licences").Protect Contents:=True, Password:="admin", AllowFiltering:=True, userinterfaceonly:=True
End Sub


Regardless THANKS so much for your help