highlight duplicate names within single cell

[raogm2001]

hi,
found a code on the web, which is working fine but i want add trim and clean the string, after add three line trim,clean and replace, it is getting hanged,
any one please help me.

[COLOR=#333333]Private Sub Worksheet_Change(ByVal Target As Range)[/COLOR]
[COLOR=#333333]Dim rng As Range, Dn As Range, n As Long, s As Variant, Sp As Variant, K As Variant[/COLOR]
[COLOR=#333333]On Error Resume Next[/COLOR]
[COLOR=#333333]If Not Intersect(Target, Range("F14:N29,F38:N53,F62:N77,F86:N101,G111:N114,G112:N115,G116:N119,G121:N124,G126:N129,G131:N134,G136:N139,G141:N144,G146:N149,G151:N154,G156:N159,G161:N164,G166:N169,G171:N174,G176:N179,G181:N184,G186:N189,G191:N194,G196:N199,G201:N204,G206:N209"), Target) Is Nothing Then[/COLOR]
[COLOR=#333333]Set rng = Range("F14:N29,F38:N53,F62:N77,F86:N101,G111:N114,G112:N115,G116:N119,G121:N124,G126:N129,G131:N134,G136:N139,G141:N144,G146:N149,G151:N154,G156:N159,G161:N164,G166:N169,G171:N174,G176:N179,G181:N184,G186:N189,G191:N194,G196:N199,G201:N204,G206:N209")[/COLOR]
[COLOR=#333333]rng.Font.Color = vbBlack[/COLOR]
[COLOR=#333333]With CreateObject("scripting.dictionary")[/COLOR]
[COLOR=#333333].CompareMode = vbTextCompare[/COLOR]
[COLOR=#333333]For Each Dn In rng[/COLOR]
[COLOR=#333333]    Sp = Split(Dn.Value, ", ")[/COLOR]
[COLOR=#333333]        For Each s In Sp[/COLOR]
[COLOR=#333333]        s = Trim(s)[/COLOR]
[COLOR=#333333]              s = Trim(Application.Clean(s))[/COLOR]
[COLOR=#333333]                s = Replace(s, Chr(10), "")[/COLOR]
[COLOR=#333333]            If Not .Exists(s) Then[/COLOR]
[COLOR=#333333]                .Add s, 1[/COLOR]
[COLOR=#333333]            Else[/COLOR]
[COLOR=#333333]                .Item(s) = .Item(s) + 1[/COLOR]
[COLOR=#333333]            End If[/COLOR]
[COLOR=#333333]        Next s[/COLOR]
[COLOR=#333333] Next Dn[/COLOR]

[COLOR=#333333]For Each Dn In rng[/COLOR]
[COLOR=#333333]    For Each K In .Keys[/COLOR]
[COLOR=#333333]      n = 1[/COLOR]
[COLOR=#333333]         Do While InStr(n, Dn.Value, K, vbTextCompare) And .Item(K) > 1[/COLOR]
[COLOR=#333333]            Dn.Characters(InStr(n, Dn.Value, K, vbTextCompare), Len(K)).Font.Color = vbRed[/COLOR]
[COLOR=#333333]             n = n + Len(K)[/COLOR]
[COLOR=#333333]        Loop[/COLOR]
[COLOR=#333333]   Next K[/COLOR]
[COLOR=#333333]Next Dn[/COLOR]
[COLOR=#333333]End With[/COLOR]
[COLOR=#333333]End If[/COLOR]
[COLOR=#333333]On Error GoTo 0[/COLOR]
[COLOR=#333333]End Sub [/COLOR]

 

[raogm2001]

i found above code athttps://www.excelforum.com/excel-pr...ight-duplicate-names-within-single-cell.html?