Move row to sheet2, sheet3 etc. based on date entered

[ms1780]

I have an excel workbook with 13 sheets. Sheet 1 is current inventory and then I have Jan Sales, Feb Sales and so on. One of the rows in my Sheet is 'Date Sold'. When I populate the 'Date Sold' field I would like it to move that row to the appropriate sheet and then remove the row from the 'Current Inventory' sheet. Here is the code I have.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("G:G")) Is Nothing Then
If Selection.Count > 1 Then Exit Sub
Dim Lastrow As Long
Dim myDate As Date
If IsDate(Target.Value) Then myDate = Target.Value
If myDate >= #1/1/2018# And myDate <= #1/31/2018# Then Lastrow = Sheets(2).Cells(Rows.Count, "A").End(xlUp).Row + 1
Rows(Target.Row).Copy Destination:=Sheets(2).Rows(Lastrow): Rows(Target.Row).Delete
ElseIf myDate >= #2/1/2018# And mydDate <= #2/28/2018# Then Lastrow = Sheets(3).Cells(Rows.Count, "A").End(xlUp).Row + 1
Rows(Target.Row).Copy Destination:=Sheets(3).Rows(Lastrow): Rows(Target.Row).Delete
End If
End Sub

I will continue with the rest of the date ranges if I can get this to work. Right now I get a Run-time error '1004: Application-defined or object-defined error on the 'Rows(Target.Row).Copy Destination:=Sheets(2).Rows(Lastrow)'

Thanks for any help.

Mike

 

[Joe4]

Welcome to the Board!

I think that you are trying to do too much in each line, are missing some text, and have a type (mydDate).

Try this structure:

Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target, Range("G:G")) Is Nothing Then Exit Sub
    If Selection.Count > 1 Then Exit Sub

    Dim Lastrow As Long
    Dim myDate As Date
    
    If IsDate(Target.Value) Then myDate = Target.Value
    
    If myDate >= #1/1/2018# And myDate <= #1/31/2018# Then
        Lastrow = Sheets(2).Cells(Rows.Count, "A").End(xlUp).Row + 1
        Rows(Target.Row).Copy Destination:=Sheets(2).Rows(Lastrow): Rows(Target.Row).Delete
    ElseIf myDate >= #2/1/2018# And myDate <= #2/28/2018# Then
        Lastrow = Sheets(3).Cells(Rows.Count, "A").End(xlUp).Row + 1
        Rows(Target.Row).Copy Destination:=Sheets(3).Rows(Lastrow): Rows(Target.Row).Delete
    End If
    
End Sub

 

[dmt32]

Hi,
untested but see if this does what you want

Place both codes in your worksheets code page

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("G:G")) Is Nothing Then
    If Selection.Count > 1 Then Exit Sub
    If IsDate(Target.Value) Then DateSold Target, DateValue(Target.Value)
    End If
End Sub


Sub DateSold(ByVal Target As Range, ByVal SoldDate As Date)
    Dim SoldMonth As Integer
    Dim LastRow As Long
    
    SoldMonth = Month(SoldDate) + 1
    With ThisWorkbook.Worksheets(SoldMonth)
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
        Target.EntireRow.Copy .Cells(LastRow, 1)
    End With
    Target.EntireRow.Delete
End Sub

Dave