Public Sub ReplaceDuplicates()
Dim n As Long
Dim p As Long
Dim q As Long
Dim h As Long
Dim w As Long
Dim x As Long
Dim y As Long
Dim d As Collection
Dim t As String
Dim r As Range
Dim u As Variant
Dim v As Variant
Dim z As Variant
' Errors...
On Error Resume Next
' Initialize...
h = 100
w = 2
x = 1
y = 1
' Affected sheet...
With ActiveSheet
' Range...
Set r = .Range(.Cells(y, x), .Cells(y + h - 1, x + w - 1))
' Read...
u = r.Value
' Redim...
ReDim v(LBound(u, 1) To UBound(u, 1), _
LBound(u, 2) To UBound(u, 2))
' Loop...
For n = LBound(u, 1) To UBound(u, 1)
For p = LBound(u, 2) To UBound(u, 2)
' Check...
If Len(u(n, p)) > 0 Then
' Clear...
Set d = New Collection
' Split...
z = Split(u(n, p), " ")
' Loop...
For q = LBound(z) To UBound(z)
' Check...
If Len(z(q)) > 0 Then
' Try...
t = ""
t = d(LCase(z(q)))
' Verify...
If Len(t) < 1 Then
' Add...
d.Add LCase(z(q)), LCase(z(q))
' Append...
v(n, p) = v(n, p) & " " & z(q)
End If
End If
Next
' Trim...
v(n, p) = Trim(v(n, p))
' Clear...
Set d = Nothing
End If
Next
Next
' Write...
r.Offset(0, w) = v
End With
End Sub