Check for similarities within a single cell - excel

Question

Does anyone knows how to higlight similar words within a single cell?
What I want to achieve is to find duplicates/similar words between < ; > in a cell.
example cell:
home;music;car;window;musician
desired result:
music in a word musician is hilglighted or the output is 'TRUE' in the next column if similar word like this has been found.
I was able to compare words between two columns but not within single cell.
So far I was able to create a formula to separate the words in the cell to have each range separate to work with.
Function IdDuplicates(rng As Range) As String
Dim StringtoAnalyze As Variant
Dim I As Integer
Dim J As Integer
Const minWordLen As Integer = 4
StringtoAnalyze = Split(UCase(rng.Value), ";")
For I = UBound(StringtoAnalyze) To 0 Step -1
If Len(StringtoAnalyze(I)) < minWordLen Then GoTo SkipA
For J = 0 To I - 1
If StringtoAnalyze(J) = StringtoAnalyze(I) Then
IdDuplicates = "TRUE"
GoTo SkipB
End If
Next J
SkipA:
Next I
IdDuplicates = "FALSE"
SkipB:
End Function
Any ideas?

Answer 1

This function returns either FALSE or a list of the similar words
Option Explicit
Function IdDuplicates(rng As Range) As String
Dim s As String, word, m As Object, i As Long
With CreateObject("VBScript.RegExp")
.IgnoreCase = True
.Global = True
s = Trim(rng.Value2)
For Each word In Split(s, ";")
.Pattern = word
Set m = .Execute(s)
If m.Count > 1 Then
IdDuplicates = IdDuplicates & "," & word
End If
Next
End With
If IdDuplicates = "" Then
IdDuplicates = "FALSE"
Else
IdDuplicates = Mid(IdDuplicates, 2) ' remove lead ,
End If
End Function

Answer 2

Match Partially in Delimited String
Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose: Returns a boolean indicating whether any of the substrings
' in a delimited string is contained in another substring.
' Example: 'music;car;musician' - 'music' is found in 'musician' - TRUE
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function MatchPart( _
ByVal DelimitedString As Variant, _
Optional ByVal StringDelimiter As String = ";") _
As Boolean
Dim S As String: S = CStr(DelimitedString)
Dim Substrings() As String
Substrings = Split(DelimitedString, StringDelimiter)
Dim sUpper As Long: sUpper = UBound(Substrings)
If sUpper < 1 Then Exit Function
Dim i As Long, j As Long, iPos As Long
Dim iSub As String, jSub As String
For i = 0 To sUpper - 1
iSub = Substrings(i)
For j = i + 1 To sUpper
jSub = Substrings(j)
'Debug.Print i, iSub, j, jSub
If Len(iSub) <= Len(jSub) Then
If InStr(1, jSub, iSub, vbTextCompare) > 0 Then
MatchPart = True
Exit Function
End If
Else
If InStr(1, iSub, jSub, vbTextCompare) > 0 Then
MatchPart = True
Exit Function
End If
End If
Next j
Next i
End Function