What is the best way to do this?

[htchandler]

Rows are each individual, Columns are information about each individual. In one of those column's I'm going to have a drop down menu to select "Present", "Absent", "Training", etc. When you select any one of these I want something to cause some of that individual's information to be copied over to a seperate tab to build a roster of all those that are "Present", "Absent", etc. What do I use to cause each individual's information to be copied to a seperate tab?

 

[htchandler]

That definately worked. Thank You. I just need one more modification and it should be perfect. To fit the format on the sheet that it pastes on to it needs to paste into Colum's B,C, and D, and the first name pasted to that list needs to paste on line 5. Is that possible?

 

[VoG]

Try

Private Sub Worksheet_Change(ByVal Target As Range)
Dim LR As Long
If Target.Column = 1 And Target.Value <> "" Then 'this is for column A, for column E use 5 and so on
    LR = WorksheetFunction.Max(Sheets(Target.Value).Range("B" & Rows.Count).End(xlUp).Row, 5)
    Target.Offset(, 1).Resize(, 3).Copy Destination:=Sheets(Target.Value).Range("B" & LR + 1)
    Target.Offset(, 5).Copy Destination:=Sheets(Target.Value).Range("E" & LR + 1)
End If
End Sub

 

[htchandler]

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Then 'this is for column A, for column E use 5 and so on
Target.EntireRow.Copy Destination:=Sheets(Target.Value).Range("A" & Rows.Count).End(xlUp).Offset(1)
End If
End Sub

Above is the code I am going to use, which was previously posted. At first I had my doubts, but it works best because it has their duty status, their SSN, and their gender. All this information makes lodging forecasts alot easier.

Now what I need is to know is: Is it possible to modify this coding so each individual can only be on one roster at a time? In a previous post VoG mentioned using an individuals SSN as an identifier, which from what I can see would work fine. Anyone want to take a stab at modifying the above coding to allow each individual to only be on one roster?

A couple factors:

If an individual is selected for one status e.g. "present", then are changed to a different status, I need their name pulled off the initial roster, and moved to the roster of their new status. Additionally I need the names on the roster an individual is removed from to move up to fill the empty space. Anyone want to take a stab at it?

 

[VoG]

Try

Private Sub Worksheet_Change(ByVal Target As Range)
Dim SSN As Variant, ws As Worksheet, Found As Range
If Target.Column = 1 Then 'this is for column A, for column E use 5 and so on
    Target.EntireRow.Copy Destination:=Sheets(Target.Value).Range("A" & Rows.Count).End(xlUp).Offset(1)
End If
SSN = Target.Offset(, 4).Value
For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> Me.Name And ws.Name <> Target.Value Then
        With ws
            Set Found = .Columns("E").Find(what:=SSN, LookIn:=xlValues, lookat:=xlWhole)
            If Not Found Is Nothing Then Found.EntireRow.Delete
        End With
    End If
Next ws
End Sub

 

[htchandler]

That works great VoG, just as advertised. Thank you.

 

[htchandler]

Private Sub Worksheet_Change(ByVal Target As Range)
Dim SSN As Variant, ws As Worksheet, Found As Range
If Target.Column = 1 Then 'this is for column A, for column E use 5 and so on
    Target.EntireRow.Copy Destination:=Sheets(Target.Value).Range("A" & Rows.Count).End(xlUp).Offset(1)
End If
SSN = Target.Offset(, 4).Value
For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> Me.Name And ws.Name <> Target.Value Then
        With ws
            Set Found = .Columns("E").Find(what:=SSN, LookIn:=xlValues, lookat:=xlWhole)
            If Not Found Is Nothing Then Found.EntireRow.Delete
        End With
    End If
Next ws
End Sub

The code above, previously posted, is working great. I've found some places for improvement to make sure user error will not cause any miscalculation's.

1. If I select any status (e.g. "Absent") on the same person multiple times it posts them to the roster again and again. Can coding be added to prevent a person from adding onto a roster multiple times?

2. I need the ability to go from any status (e.g. "present) to a blank selection without bringing up a runtime error, and of course I need it to still remove that individual from their previous status's roster.

Thank you again for everyone's input. I appreciate the help on this, it's going to save my staff significant time everyday.

 

[VoG]

Try

Private Sub Worksheet_Change(ByVal Target As Range)
Dim SSN As Variant, ws As Worksheet, Found As Range
If Target.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
If Target.Column = 1 Then 'this is for column A, for column E use 5 and so on
    Set Found = Sheets(Target.Value).Columns("E").Find(what:=Target.Offset(, 4).Value, LookIn:=xlValues, lookat:=xlWhole)
    If Found Is Nothing Then
        Target.EntireRow.Copy Destination:=Sheets(Target.Value).Range("A" & Rows.Count).End(xlUp).Offset(1)
    Else
        MsgBox "Already entered on that roster", vbExclamation
        Exit Sub
    End If
End If
SSN = Target.Offset(, 4).Value
For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> Me.Name And ws.Name <> Target.Value Then
        With ws
            Set Found = .Columns("E").Find(what:=SSN, LookIn:=xlValues, lookat:=xlWhole)
            If Not Found Is Nothing Then Found.EntireRow.Delete
        End With
    End If
Next ws
End Sub

 

[htchandler]

Thank you again VOG. The solution for preventing duplicate entrys is working perfect, I like the alert that comes up too notifying the user.

The selection of a blank option on the drop down menu is not pulling the individual off the roster they were posted to before selecting the blank option. Any ideas?

 

[VoG]

Try this

Private Sub Worksheet_Change(ByVal Target As Range)
Dim SSN As Variant, ws As Worksheet, Found As Range
If Target.Count > 1 Then Exit Sub
If Target.Value <> "" Then
    If Target.Column = 1 Then 'this is for column A, for column E use 5 and so on
        Set Found = Sheets(Target.Value).Columns("E").Find(what:=Target.Offset(, 4).Value, LookIn:=xlValues, lookat:=xlWhole)
        If Found Is Nothing Then
            Target.EntireRow.Copy Destination:=Sheets(Target.Value).Range("A" & Rows.Count).End(xlUp).Offset(1)
        Else
            MsgBox "Already entered on that roster", vbExclamation
            Exit Sub
        End If
    End If
End If
SSN = Target.Offset(, 4).Value
For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> Me.Name And ws.Name <> Target.Value Then
        With ws
            Set Found = .Columns("E").Find(what:=SSN, LookIn:=xlValues, lookat:=xlWhole)
            If Not Found Is Nothing Then Found.EntireRow.Delete
        End With
    End If
Next ws
End Sub

 

[htchandler]

Perfection!!! Thank you Vog.