Excel 2007 : Create list on new worksheet based on cell value

**ztaylor0** · 01-03-2012, 06:06 PM

I am new to the forum and tried to find what i was looking for prior to posting but could only find posts that were similar but not quite what I needed. So here goes.

I have a list of investors on my Master sheet, and I need to create a list based on the responses in Column B-E. I have attached an example sheet. I need the investor number to be included on a list on the appropriate sheet.

ex:
Investor HAM PRA UP HAFA
00064 no yes no input no
I need investor #00064 to go to 4 corresponding sheets, HAM NO, PRA YES, UP UNKNOWN, and HAFA NO.

I do not want the investor number to be removed from the Master sheet.

**arlu1201** · 01-04-2012, 04:37 AM

Just a couple of questions for u.
1. The other tabs dont have any headers, so i believe that only the Investor number should be copied there right?
2. Would this copying of data be done on a click of a button? So, after all the entries are done, you would click the button and the data would be transferred?

**ztaylor0** · 01-04-2012, 10:56 AM

1. Yes only investor number should transfer
2. I need it to be ongoing, so when a no is changed to a yes then the investor number is automatically moved from one list to another.

**arlu1201** · 01-15-2012, 02:31 PM

Use this code -

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 Then
    If Target.Value = "no" Then
        Cells(Target.Row, 1).Copy Worksheets("HAM NO").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
        On Error Resume Next
        Set rcell = Worksheets("HAM YES").Cells.Find(What:=Cells(Target.Row, 1).Value, After:=Range("A1"), LookIn:=xlValues, LookAt:= _
            xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
        rcell.Value = ""
        Set rcell = Worksheets("HAM UNKNOWN").Cells.Find(What:=Cells(Target.Row, 1).Value, After:=Range("A1"), LookIn:=xlValues, LookAt:= _
            xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
        rcell.Value = ""
    ElseIf Target.Value = "yes" Then
        Cells(Target.Row, 1).Copy Worksheets("HAM YES").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
        On Error Resume Next
        Set rcell = Worksheets("HAM NO").Cells.Find(What:=Cells(Target.Row, 1).Value, After:=Range("A1"), LookIn:=xlValues, LookAt:= _
            xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
        rcell.Value = ""
        Set rcell = Worksheets("HAM UNKNOWN").Cells.Find(What:=Cells(Target.Row, 1).Value, After:=Range("A1"), LookIn:=xlValues, LookAt:= _
            xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
        rcell.Value = ""
    ElseIf Target.Value = "" Then
        Cells(Target.Row, 1).Copy Worksheets("HAM UNKNOWN").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
        On Error Resume Next
        Set rcell = Worksheets("HAM YES").Cells.Find(What:=Cells(Target.Row, 1).Value, After:=Range("A1"), LookIn:=xlValues, LookAt:= _
            xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
        rcell.Value = ""
        Set rcell = Worksheets("HAM NO").Cells.Find(What:=Cells(Target.Row, 1).Value, After:=Range("A1"), LookIn:=xlValues, LookAt:= _
            xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
        rcell.Value = ""
    End If
ElseIf Target.Column = 3 Then
'REpeat above code for PRA
ElseIf Target.Column = 4 Then
'REpeat above code for UP
ElseIf Target.Column = 5 Then
'Repeat above code for HAFA
End If

For i = 1 To Worksheets.Count
    If Worksheets(i) <> "Master" Then
        Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
            Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
            :=Array(1, 1), TrailingMinusNumbers:=True
        Columns("A:A").RemoveDuplicates Columns:=1, Header:=xlNo
    End If
Next i

End Sub

I have completed the code for HAM YES, NO & UNKNOWN. Just copy the same code for PRA, UP & HAFA and change the sheet names. Do let me know if you need help with it.

You need to right click on Master tab, click view code and copy the above code there.