Moving row into new sheet meeting two separate criteria from 2 different columns.

[Gryder]

Hello Everyone,

I have 5 tabs or Sheets named, Weekly, Monthly, Quarterly, Semi-Annual and Annual. All the information from each 5 tabs will go into another sheet Called "archive engagement" (that's what it is called in my code) for everything that's due.

I have this vba code that works when I change the date in column E and it moves that information into another worksheet I have.

The problem is, I also want it to check column I, which says "Weekly" or "Monthly" etc. (I want to send the information back to one of the 5 tabs). I only want to move the row when both condition are meet.

I have to be able to input a date in column E and column I will have "weekly" or "Monthly" etc. (these are static from what ever tab they came from in column I ) and once they condition is meet if moves everything over back to its original sheet. (which are the 5 tabs. Weekly, monthly, quarterly. etc. )

I have tried using target.column And target.value together but it does not work.

Any help is appreciated. I will paste the code below. Thanks, Garrett

Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("E:E", "I:I")) Is Nothing Then
If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
Application.ScreenUpdating = False
Dim Lastrow As Long
Dim r As Long
Dim Lastrowa As Long
Lastrow = Sheets("current engagement").Cells(Rows.Count, "E").End(xlUp).row + 1
Lastrowa = Sheets("archive engagement").Cells(Rows.Count, "E").End(xlUp).row + 1
If Target.Column = 5 & "" And Target.Column = 9 & "Weekly" Then <----------------------- This is the row that is giving me all the issues or errors out.
Rows(Target.row).Copy Destination:=Sheets("current engagement").Rows(Lastrow)
Application.EnableEvents = False
Rows(Target.row).Delete
Application.EnableEvents = True
Exit Sub
End If

Application.EnableEvents = True
Application.ScreenUpdating = True
End If
End Sub

 

[DanteAmor]

Hi and welcome to MrExcel

Check if the following is what you need

Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("E:E", "I:I")) Is Nothing Then
    If Target.CountLarge > 1 Then Exit Sub
    If IsEmpty(Target) Then Exit Sub
  
    Dim Lastrow As Long
    Dim Lastrowa As Long
  
    Application.ScreenUpdating = False
  
    Lastrow = Sheets("current engagement").Cells(Rows.Count, "E").End(xlUp).Row + 1
    Lastrowa = Sheets("archive engagement").Cells(Rows.Count, "E").End(xlUp).Row + 1
    If Range("E" & Target.Row) <> "" And Range("I" & Target.Row) = "Weekly" Then
      Rows(Target.Row).Copy Sheets("current engagement").Rows(Lastrow)
      Application.EnableEvents = False
      Rows(Target.Row).Delete
      Application.EnableEvents = True
    End If
  
    Application.ScreenUpdating = True
  End If
End Sub

 

[Gryder]

Works Perfect. Thank you so much DanteAmor!

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.