Moving rows based on more then one criteria

[BOB101]

Hello Everyone,
I need some help. My VP tasked me with creating a new work sheet for our team. He wants when someone puts "Y" in column "J" the entire row will move to one of two possible tabs depending on what's in column "I". as we have multiple colored zones & the two people who work on them split them. The zones are Green, Yellow, & Blue would go to Hilary's tab & Pink, Red, Beach Blue, & Purple go to Paul. The zones are in column "I". I need a code that when someone puts a "Y" in column "J", that row will move to Hilary's or Paul's tabs depending on what we have in column "I".

Thank you

 

[Crystalyzer]

You can do this by setting up a simple worksheet with the zones and worksheet names (I used the actual person's names as the sheet names for my example. You can change these to suit your needs or add new ones later). The code is looking for this worksheet named "Zone Lookup" with a range name of "ZoneLookup" on it as follows

Book8
	A	B
1	Zone	Sheet Name
2	Green	Hilary
3	Yellow	Hilary
4	Blue	Joe
5	Pink	Paul
6	Red	Paul
7	Beach Blue	Paul
8	Purple	Paul
Zone Lookup

Then place this code in the Worksheet Change event of the "Master" worksheet

Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Target.Column = 10 And UCase(Target.Value) = "Y" Then
        Application.EnableEvents = False
        Application.ScreenUpdating = False
        
        Dim lr As Long, zone As String
        Dim trgWsName As String
        Dim ws As Worksheet
        Dim mstrCellAddr As String
        
        mstrCellAddr = Target.Address
        zone = Target.Offset(0, -1).Value
        On Error Resume Next
        trgWsName = WorksheetFunction.VLookup(zone, Sheets("Zone Lookup").Range("ZoneLookup"), 2, 0)
        On Error GoTo 0
        
        If trgWsName <> "" Then
            If WsExists(trgWsName) Then
                With Sheets(trgWsName)
                    lr = .Cells(Rows.Count, 9).End(xlUp).Row + 1
                    Target.EntireRow.Copy .Range(lr & ":" & lr)
                    Target.EntireRow.Delete
                    Range(mstrCellAddr).Select
                End With
            Else
                MsgBox "The target worksheet could not be found.  No rows moved.", vbOKOnly
            End If
        Else
            MsgBox "The zone could not be found.  No rows moved.", vbOKOnly
        End If
        
        Application.EnableEvents = True
        Application.ScreenUpdating = True
    End If
End Sub

And place this code into a module in the same workbook. this is a user defined function that will check that the target worksheet exists.

Public Function WsExists(ws2find As String) As Boolean
    WsExists = False
    For Each Sheet In Worksheets
        If ws2find = Sheet.Name Then
            sheetExists = True
            Exit Function
        End If
    Next Sheet
End Function