This macro, gives the same results as NBVC's formula from post 10 (except the #N/A is left blank)
Code:
Sub FirstBeadType()
Dim listRng As Range, cel As Range
Dim i As Long, lr As Long
With Sheets("BeadTypes")
Set listRng = .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
End With
With Sheets("Description")
lr = .Range("D" & .Rows.Count).End(xlUp).Row
For Each cel In listRng
For i = 2 To lr
If .Cells(i, "A") = "" And InStr(1, .Cells(i, "D"), cel.Value, vbTextCompare) > 0 Then
.Cells(i, "A") = cel.Value
End If
Next i
Next cel
End With
End Sub