Add multiple columns with string data from another column

This program places a name in Column E from a string in Column D. How can I introduce a Column F for strings with 2 names? Could Column G work for a 3rd?

Sub name1() 'Main Program

Dim nmArr()
Dim i As Long
Dim cl As Range

Set cl = ActiveSheet.Range("D2") '## This is the STARTING cell

'## This is the list of names built as an array
nmArr = Array("Christy", "Kari", "Sue", "Clayton", "DanK", "Gawtry", Holly", "John", "Matt", "Dustin", "David")
Do
    For i = LBound(nmArr) To UBound(nmArr)
        If InStr(1, cl.Value, nmArr(i), vbTextCompare) Then
            cl.Offset(0, 1).Value = nmArr(i)
            Exit For
        End If
    Next

    '## Get a handle on the NEXT cell
    Set cl = cl.Offset(1, 0)
Loop Until Trim(cl.Text) = vbNullString
outcome1

End Sub

@Scottcramer : Here is what my data looks like...