This should do what you want

Sub Tester1()
Dim x As Range, y As Range
Dim y1 As Range, x1 As Range
Dim ya As String, yb As String
Dim CompareRange As Range
Dim sStr As String
Set CompareRange = ThisWorkbook. _
Worksheets("Sheet1").Range("A4:A80")
For Each x In Selection.Columns(1).Cells
For Each y In CompareRange
If UCase(x) = UCase(y) Or _
UCase(x.Offset(0, 1)) = UCase(y.Offset(0, 1)) Then
Set x1 = x.Offset(0, 1)
Set y1 = y.Offset(0, 1)
Select Case True
Case InStr(1, y, _
"variant", vbTextCompare) = 0 _
And InStr(1, y.Offset(0, 1), _
"variant", vbTextCompare) = 0
If UCase(x) = UCase(y) And _
UCase(x1) = UCase(y1) Then
x.Offset(0, 2) = x & ", " & x1
If IsNumeric(x) Then
If x = 0 Then
x.Offset(0, 2) = ""
End If
End If
End If
Case InStr(1, y, _
"variant", vbTextCompare) 0 _
And InStr(1, y1, _
"variant", vbTextCompare) = 0
sStr = y.Value
sStr = Application.Trim( _
Application.Substitute(sStr, "variant", ""))
ya = Left(sStr, InStr(sStr, " ") - 1)
yb = Right(sStr, Len(sStr) - (Len(ya) + 1))
If UCase(x) = UCase(ya) Or UCase(x) = UCase(yb) And _
UCase(x1) = UCase(y1) Then
x.Offset(0, 2) = x & ", " & x1
End If
Case InStr(1, y, _
"variant", vbTextCompare) = 0 _
And InStr(1, y1, _
"variant", vbTextCompare) 0

sStr = y1.Value
sStr = Application.Trim( _
Application.Substitute(sStr, "variant", ""))
ya = Left(sStr, InStr(sStr, " ") - 1)
yb = Right(sStr, Len(sStr) - (Len(ya) + 1))
If UCase(x1) = UCase(ya) Or UCase(x1) = UCase(yb) And _
UCase(x) = UCase(y) Then
x.Offset(0, 2) = x & ", " & x1
End If
End Select
End If
If IsNumeric(x) Then
If x = 0 Then
x.Offset(0, 2) = ""
End If
End If

Next y
Next x
End Sub


--
Regards,
Tom Ogilvy


excelnewbie wrote in message
...
Hi Tom! Hope everything is well.

The variant is in the Y/Compare Range.

Thanks,

MC:)



------------------------------------------------
~~ Message posted from http://www.ExcelTip.com/
~~ View and post usenet messages directly from http://www.ExcelForum.com/