Move rows based on 2 different values

[kanderson83]

I am trying to have rows automatically move to different sheets based on 2 different values. I want the row to move once "resolved" but I want it to move to a specific sheet based on the partner. I am currently using this code below to have the rows move automatically from the "currently working" sheet to the "resolved " sheet. Instead of moving to resolved, I would like them to move to a sheet based on the partner name in column "C."

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    Application.EnableEvents = False
    'If Cell that is edited is in column G and the value is resolved then
    If Target.Column = 7 And Target.Value = "Resolved" Then
        'Define last row on resolved worksheet to know where to place the row of data
        LrowResolved = Sheets("Resolved").Cells(Rows.Count, "A").End(xlUp).Row
        'Copy and paste data
        Range("A" & Target.Row & ":H" & Target.Row).Copy Sheets("Resolved").Range("A" & LrowResolved + 1)
        'Delete Row from Project List
        Range("A" & Target.Row & ":H" & Target.Row).Delete xlShiftUp
    End If
    Application.EnableEvents = True
End Sub

 

[Fluff]

Is the value in col C the same as the worksheet name?
Also what happens if the sheet doesn't exist?

 

[kanderson83]

Value in C is the same as the worksheet name. MXCCM, Credico, Sprint Direct

Could I keep the resolved sheet in the case that a sheet doesn't exist? Or in that case, could it stay on the "currently working" page?

 

[Fluff]

Ok, how about

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim Ws As Worksheet
   On Error GoTo Xit
   Application.EnableEvents = False
   'If Cell that is edited is in column G and the value is resolved then
   If Target.Column = 7 And Target.Value = "Resolved" Then
      If Evaluate("isref('" & Target.Offset(, -4).Value & "'!A1)") Then
         Set Ws = Sheets(Target.Offset(, -4).Value)
      Else
         Set Ws = Sheets("Resolved")
      End If
         'Define last row on resolved worksheet to know where to place the row of data
         LrowResolved = Ws.Cells(Rows.Count, "A").End(xlUp).Row
         'Copy and paste data
         Range("A" & Target.Row & ":H" & Target.Row).Copy Ws.Range("A" & LrowResolved + 1)
         'Delete Row from Project List
         Range("A" & Target.Row & ":H" & Target.Row).Delete xlShiftUp
      End If
   End If
Xit:
   Application.EnableEvents = True
End Sub

 

[kanderson83]

I get this error

 

[Fluff]

Oops, delete one of these End If lines

         Range("A" & Target.Row & ":H" & Target.Row).Delete xlShiftUp
      End If
   End If
Xit:

 

[kanderson83]

That worked! Thank you so much!

 

[Fluff]

You're welcome & thanks for the feedback

 

[Juddman79]

I think what I'm trying to achieve is the similar to the original post, but apologies if it isn't. I'm using the code below to move rows marked as 'accepted' (column 4) to a different sheet (sheet2). I would like to add more code into this to move rows marked as 'rejected' (column 4) to another sheet (sheet3). I just don't know what to do.

Also how to get the macro to accept all cases in the target cell (not just lower case)??

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 4 And Target.Cells.Count = 1 Then
        If LCase(Target.Value) = "accepted" Then
            With Target.EntireRow
                .Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
                .Delete
            End With
        End If
    End If
End Sub

Many thanks in advance for your help

 

[Fluff]

How about

Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.CountLarge > 1 Then Exit Sub
   If Target.Column = 4 Then
      If LCase(Target.Value) = "accepted" Then
         With Target.EntireRow
            .Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
            .Delete
         End With
      ElseIf LCase(Target.Value) = "rejected" Then
         With Target.EntireRow
            .Copy Sheets("Sheet3").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
            .Delete
         End With
      End If
   End If
End Sub

The code is case insensitive, so it doesn't matter how it's entered into the sheet.