Sub GetRelOpt()
Dim lngR As Long
Dim varToMatch As Variant
Dim rngCell As Excel.Range
Dim rngColumn As Excel.Range

Set rngColumn = Range("A1", Cells(Rows.Count, 1).End(xlUp))
For Each rngCell In rngColumn
If Len(rngCell.Value) Then
varToMatch = rngCell.Value
lngR = 2
Do While rngCell(lngR, 1).Value = varToMatch
rngCell(1, 2).Value = rngCell(1, 2).Value & ", " & rngCell(lngR, 2).Value
rngCell(lngR, 2).EntireRow.Clear
lngR = lngR + 1
Loop
End If
Next
rngColumn.EntireRow.Sort key1:=Range("A1")
End Sub
'------------


"Debi H"
wrote in message
It still did not work and pick up the hood and put the data in the cell in
the B column that related to the hood. Also it put it in 3 different cells
not one