Multi names in one cell copied to single cell

[ron_dallas]

I have a S/S, Column A, has Applications, Colimn B, has multi name
seperated by "," and Column C has the main person.

Is there a way for to go from :
sheet 1
A B C
CUP Ron, Tim, Jill, Tom Rick

to sheet 2
A B C
CUP Ron Rick
CUP Tim Rick
CUP Jill Rick
CUP Tom Rick

Other info:
The multi name can be from 1 to 6 people, there are 186 rows, the names
can have - and / in it, also I would like to copy the color of the
cell.

Thanks for your help!!

 

[Zone]

Ron, 1. Do you mean the names in column B can be separated by - or /
instead of by a comma? 2. Do you want to copy the color of column A,
B, C, or all 3? 3. Are you wanting to copy the font color or the
interior (background) color? James

 

[ron_dallas]

Names can have / or - in them, like ron-smith (treat as one Name)
The same color goes acrros the row, but I can live with just column A.
and it's only the backgroup color I am looking at. Text Color and Font
are default.

Thanks for looking at this
Ron

 

[Zone]

Ron, This routine could probably be shorter and more efficient, but I
think it does what you want. Copy it into a standard module. You said
nothing about a header row, so I presumed there isn't one. If you want
to skip row 1 for a header row, set k2=2 and For k=2 instead of 1. I
also presumed you want to do the whole Sheet 1, not a range. James

Sub SeparateNames()
Dim k As Long, k2 As Long, i As Integer
Dim StartStr As String, PutStr As String
Worksheets("Sheet2").Activate
Cells.Clear
k2 = 1
With Worksheets("Sheet1")
For k = 1 To .Cells(65536, "a").End(xlUp).Row
StartStr = .Cells(k, "b")
PutStr = ""
For i = 1 To Len(StartStr)
If Mid(StartStr, i, 1) = "," Then
Cells(k2, "b") = PutStr
PutStr = ""
Cells(k2, "a") = .Cells(k, "a")
Range("a" & CStr(k2) & ":c" &
CStr(k2)).Interior.ColorIndex _
= .Cells(k, "a").Interior.ColorIndex
Cells(k2, "c") = .Cells(k, "c")
k2 = k2 + 1
Else
If Len(PutStr) <> 0 Or Mid(StartStr, i, 1) <> " " _
Then PutStr = PutStr & Mid(StartStr, i, 1)
End If
Next i
Cells(k2, "b") = PutStr
PutStr = ""
Cells(k2, "a") = .Cells(k, "a")
Range("a" & CStr(k2) & ":c" & CStr(k2)).Interior.ColorIndex _
= .Cells(k, "a").Interior.ColorIndex
Cells(k2, "c") = .Cells(k, "c")
k2 = k2 + 1
Next k
End With
End Sub

 

[ron_dallas]

GREAT JOB!!!
Works Great!!!
Thanks for your help!!!!!!

can you tell I am happy

 

[Zone]

Ron, and thanks for letting me know. The part between Next i and Next
k is kinda ragged. It has to go one more time at the end of the start
string to get the final character. But, it gets the job done. James