Compare two strings and highlight the differences

YasserKhalil
PlatinumLounger
Posts: 4911
Joined: 31 Aug 2016, 09:02

Compare two strings and highlight the differences

Post by YasserKhalil »

Hello everyone
I have two columns B and C which has similar strings and I would like to compare between them and highlight the different parts
Example:
in column B: Hello my tutor Mr. Hans
In Column C: Hello my tuto Mr Hans

In that case Mr. is different from Mr so I need to highlight the difference or list the difference in another column (say D ) like that
Mr. / Mr

Another example:
In column B: I am very grateful to that forum
In Column C: I am so grateful to this forum

in that case there are two differences, so in column D, I expect
very / so * that / this

I have found this UDF

Code: Select all

Function TxtFilter(val1 As String, val2 As String, sep As String) As String
    Dim arr1, arr2, dict As Object, x As Long
    Set dict = CreateObject("Scripting.Dictionary")
    arr1 = Split(val1, sep)
    arr2 = Split(val2, sep)
    For x = LBound(arr1) To UBound(arr1)
        dict(arr1(x)) = 1
    Next x
    For x = LBound(arr2) To UBound(arr2)
        If dict.Exists(arr2(x)) Then dict.Remove arr2(x)
    Next x
    TxtFilter = Join(dict.Keys, sep)
End Function
But this list only the value from the column B

Thanks advanced for help

User avatar
HansV
Administrator
Posts: 78231
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Compare two strings and highlight the differences

Post by HansV »

Code: Select all

Function TxtFilter(val1 As String, val2 As String, sep As String) As String
    Const sep1 = " * "
    Const sep2 = " / "
    Dim arr1
    Dim arr2
    Dim n1 As Long
    Dim n2 As Long
    Dim x As Long
    Dim s As String
    arr1 = Split(val1, sep)
    n1 = UBound(arr1)
    arr2 = Split(val2, sep)
    n2 = UBound(arr2)
    For x = 0 To Application.Min(n1, n2)
        If arr1(x) <> arr2(x) Then
            s = s & sep1 & arr1(x) & sep2 & arr2(x)
        End If
    Next x
    If n1 > n2 Then
        For x = n2 + 1 To n1
            s = s & sep1 & arr1(x) & sep2 & "<empty>"
        Next x
    ElseIf n2 > n1 Then
        For x = n1 + 1 To n2
            s = s & sep1 & "<empty>" & sep2 & arr2(x)
        Next x
    End If
    If s <> "" Then
        s = Mid(s, Len(sep1) + 1)
    End If
    TxtFilter = s
End Function
S3534.png
You do not have the required permissions to view the files attached to this post.
Best wishes,
Hans

YasserKhalil
PlatinumLounger
Posts: 4911
Joined: 31 Aug 2016, 09:02

Re: Compare two strings and highlight the differences

Post by YasserKhalil »

Amazing my tutor. That's exactly what I was searching for.
Thank you very much for unique solutions.