Move Rows Between Workbooks Based on Date Entered Into an Input Box

[HakunamaTadatada]

Hello All-

Newbie here...

I've found an abundance amount of code from Mr. Excel users and I have found myself stumped on coding for what I'm looking to achieve, which could result from not entering the correct phrase of words to find it.

I basically have 2 workbooks with the same information. Each week I download information from our software regarding employee changes to review for a given pay period. What I'd like to do is move rows with a date greater than or equal to the date of the beginning of the next pay period to my workbook called "Follow Up" because the data doesn't have to be reviewed at the point in time that I've downloaded it.

I am currently sorting what I download by date, then cutting and pasting the rows into my follow up workbook. I think a macro might be a bit faster and I could use it in conjunction with the macro I have for formatting the data.

Thanks in advance
Lesley

 

[Yongle]

welcome to the forum

test on a COPY of your data!

3 lines to tailor to match your circumstances

1. assumes headers are in row1 staring at A1

Set rng = ActiveSheet.Range("A1").CurrentRegion

2. where is other workbook?

Set wb = Workbooks.Open("C:\folder\subfolder\Follow Up.xlsx")

3. this places data in next available row in first sheet in other workbook

Set Destn = wb.Sheets(1).Range("A" & Rows.Count).End(xlUp).Offset(1)

Sub TryThis()
    Dim rng As Range, futureDate As String
    Dim wb As Workbook, Destn As Range
'get date
    On Error Resume Next
    futureDate = ">=" & CLng(CDate(InputBox("start next period?", "Enter date", Date)))
    If Err.Number <> 0 Then
        On Error GoTo 0
        Exit Sub
    End If
    Application.ScreenUpdating = False
'source
    Set rng = ActiveSheet.Range("A1").CurrentRegion
'destination
    Set wb = Workbooks.Open("C:\folder\subfolder\Follow Up.xlsx")
    Set Destn = wb.Sheets(1).Range("A" & Rows.Count).End(xlUp).Offset(1)
'filter data
    On Error Resume Next
        rng.Parent.ShowAllData
    On Error GoTo 0
    rng.AutoFilter Field:=1, Criteria1:=futureDate, Operator:=xlAnd
    Set rng = rng.Offset(1)
'copy and delete data
    With rng.SpecialCells(xlCellTypeVisible)
        .Copy Destn
        .EntireRow.Delete
    End With
'save and close workbook
    wb.Save
    wb.Close False
'remove filter
    On Error Resume Next
        rng.Parent.ShowAllData
    On Error GoTo 0
End Sub

 

[HakunamaTadatada]

Thank you so much for the response. I can follow along with your coding but it's not working for me. I have a feeling it's because of the way my spreadsheets are set up. Using this code, I'm getting a run-time error '1004': No cells found. Using 5/18/20 as my cut off date, all the data rows in my testing are greater than that date.

When I open up the code to debug, this is the first issue that the program doesn't like:
With rng.SpecialCells(xlCellTypeVisible)

I will continue to try and finagle with the code based on your input.

 

[Yongle]

I have a feeling it's because of the way my spreadsheets are set up.

If you need further help, either use XL2BB to provide the layout of your workbook or provide the detail in some other way
- it's easier to help if I can see what you are working with