I posted this code this morning. Notusre why you didn't get it. did
you post on the microsoft site? The microsoft site is down and not
sending e-mail when a response is posted.


Sub GetReplacement()
Set SourceSht = Sheets("Sheet1")
Set DestSht = Sheets("Sheet2")

Newrow = 1
With Sheets("sheet1")
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
'sort data by column C thenA
..Rows("1:" & LastRow).Sort _
header:=xlYes, _
key1:=.Range("C1"), _
order1:=xlAscending, _
key2:=.Range("A1"), _
order2:=xlAscending

RowCount = 2
OutputStr = ""
Do While .Range("A" & RowCount) < ""
Original = .Range("A" & RowCount)
If OutputStr = "" Then
Replacement = .Range("C" & RowCount)
OutputStr = Replacement & " replaces " & Original
Else
OutputStr = OutputStr & " , " & Original
End If

If .Range("C" & RowCount) < .Range("C" & (RowCount + 1)) Then
DestSht.Range("A" & Newrow) = OutputStr
Newrow = Newrow + 1
OutputStr = ""
End If
RowCount = RowCount + 1
Loop

End With

End Sub


--
joel
------------------------------------------------------------------------
joel's Profile: http://www.thecodecage.com/forumz/member.php?userid=229
View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=145286