Function UniqInCell(ByVal txt As String) As String
Dim temp, m As Object, n As Long
With CreateObject("VBScript.RegExp")
.Global = True
.Pattern = "([,;:\.\?] ?)"
txt = .Replace(txt, " ")
.IgnoreCase = True
.Global = False
.Pattern = "\b((.{2,})((?!e?s)|(e?s)?)) .*(\2(e?s)?)"
Do While (.test(txt))
Set m = .Execute(txt)(0)
If Not .test(txt) Then Exit Do
Dim i As Integer
i = 0
txt = Application.Replace(txt, _
m.firstindex + 1, Len(m.submatches(0)), "")
Loop
End With
UniqInCell = Application.Trim(txt)
End Function
Bookmarks