Modification of this code from John Walkenback's site. Assumes xl2000 or
later

http://j-walk.com/ss/excel/tips/tip47.htm

Sub RemoveDuplicates()
Dim AllCells As Range, Cell As Range
Dim NoDupes As New Collection
Dim i As Integer, v As Variant

' The items are in A1:A105
Set AllCells = Range("A1:A105")

' The next statement ignores the error caused
' by attempting to add a duplicate key to the collection.
' The duplicate is not added - which is just what we want!
On Error Resume Next
For Each Cell In AllCells
v = Split(cell,",")
for i = lbound(v) to ubound(v)
v(i) = Replace(v(i),".","")
v(i) = Replace(v(i),"?","")
v(i) = Replace(v(i),"!","")
NoDupes.Add v(i), CStr(v(i))
' Note: the 2nd argument (key) for the Add method must be a string
Next i
Next Cell

' Resume normal error handling
On Error GoTo 0
redim v(1 to NoDupes.count, 1 to 1)
' Sort the collection (optional)
For i = 1 To NoDupes.Count - 1
v(i,1) = NoDupes(i)
Next i

With Range("J1").Resize(Nodupes.count,1)
.Value = v
.sort Key1:=Range("J1"), Order1:=xlAscending, _
header:=xlNo
end With
End Sub

Code has not been tested and may contain typos.

--
Regards,
Tom Ogilvy


"Craig Freeman" wrote in message
om...
Good day,

I'm attempting to extract duplicate comma-delimited text strings (cell
character length greater that 255 - limitation of countif) found in a
column and return those results in a separate worksheet and in
separate rows for each duplicate found in the original column.

For example: (keep in mind, this example is less than 255 characters
per cell, but I need this to work for cell over 255 characters)

Sheet1

A1 : Horse,cow,pig,
A2 : Pig,cat,horse
A3 : Cow,dog,cat

Would return:

Sheet2

A1 : Horse
A2 : Cow
A3 : Pig
A4 : Cat
A5 : Dog

Any VBA miracle minds attempting this one, will have my deepest
gratitude.


thanks,