VBA code for Text Diff between two columns?

[Akila868]

Hi friends,

I need big help on the following.

I have two columns with texts. Column A has the old text and Column B has the new text. I need to match these two and show in a 3rd column the additional characters (highlighted in red color) in B column compared to A column text. Further in D column to show the additional characters separately.

Would really appreciate if this can be done. Thanks in advance.
Ex.

Column A	Column B	Column C	Column D
Test123$ New.	Test123E Newest	Test123E Newest	Eest

<tbody>
</tbody>

 

[Akila868]

Would appreciate your support in this.

 

[Akila868]

Anyone?

 

[pmich]

Try this :

Private Sub CompareAndWriteWithColor()
  Dim TxtA As String
  Dim TxtB As String
  Dim TxtC As String
  Dim TxtD As String
  Dim intPos As Integer
  Dim strColorPosition() As String
  Dim blDimensioned As Boolean
  Dim strText As String
  Dim lngPosition As Long
  blDimensioned = False
  Sheets("Sheet3").Select
  TxtA = Range("a2").Value
  TxtB = Range("b2").Value
  For intPos = 1 To Len(TxtB)
   If Mid(TxtB, intPos, 1) = Mid(TxtA, intPos, 1) Then
    TxtC = TxtC & Mid(TxtB, intPos, 1)
   Else
    TxtC = TxtC & Mid(TxtB, intPos, 1)
    TxtD = TxtD & Mid(TxtB, intPos, 1)
    Do
     strText = intPos
     If strText <> "" Then
      If blDimensioned = True Then
       ReDim Preserve strColorPosition(0 To UBound(strColorPosition) + 1) As String
      Else
       ReDim strColorPosition(0 To 0) As String
       blDimensioned = True
      End If
      strColorPosition(UBound(strColorPosition)) = strText
      Exit Do
     End If
    Loop Until strText = ""
   End If
  Next
  Range("c2").Value = TxtC
  For lngPosition = LBound(strColorPosition) To UBound(strColorPosition)
   ActiveCell.Characters(Start:=strColorPosition(lngPosition), Length:=1).Font.ColorIndex = 3
  Next lngPosition
  Range("d2").Value = TxtD
End Sub

 

[Akila868]

Try this :

Private Sub CompareAndWriteWithColor()
  Dim TxtA As String
  Dim TxtB As String
  Dim TxtC As String
  Dim TxtD As String
  Dim intPos As Integer
  Dim strColorPosition() As String
  Dim blDimensioned As Boolean
  Dim strText As String
  Dim lngPosition As Long
  blDimensioned = False
  Sheets("Sheet3").Select
  TxtA = Range("a2").Value
  TxtB = Range("b2").Value
  For intPos = 1 To Len(TxtB)
   If Mid(TxtB, intPos, 1) = Mid(TxtA, intPos, 1) Then
    TxtC = TxtC & Mid(TxtB, intPos, 1)
   Else
    TxtC = TxtC & Mid(TxtB, intPos, 1)
    TxtD = TxtD & Mid(TxtB, intPos, 1)
    Do
     strText = intPos
     If strText <> "" Then
      If blDimensioned = True Then
       ReDim Preserve strColorPosition(0 To UBound(strColorPosition) + 1) As String
      Else
       ReDim strColorPosition(0 To 0) As String
       blDimensioned = True
      End If
      strColorPosition(UBound(strColorPosition)) = strText
      Exit Do
     End If
    Loop Until strText = ""
   End If
  Next
  Range("c2").Value = TxtC
  For lngPosition = LBound(strColorPosition) To UBound(strColorPosition)
   ActiveCell.Characters(Start:=strColorPosition(lngPosition), Length:=1).Font.ColorIndex = 3
  Next lngPosition
  Range("d2").Value = TxtD
End Sub

Hi, thank you so much for the code. This actually highlights the words with differences. Is it possible to make it to highlight the additional or missing character/s only. It could be a letter, number or a special character.

 

[pmich]

In your example '$' is replaced with 'E".
Do you mean to say that you want only '$' and est' omitting the 'E' which replaced '$'?
Give an example of how the result should be.

 

[Akila868]

No what I meant is Column C shows the full word highlighted, if there was a change in that specific word. It should instead highlight the characters that came in new/ removed/ replaced by comparing the two words in two columns. Sorry if the requirement was not clear.

Example

Column A	Column B	Column C	Column D
ABC$123.	ABCU123.	ABCU123.	U
DDD;889@	DDDL889P	DDDL889p	Lp

<tbody>
</tbody>

Just need to compare character by character from left to right in the same order and display difference in characters. Hope this is clear now. Thank you so much for taking the time to help me. Really appreciate it.

 

[Akuini]

Hi, Akila868.
Try this:
Since the code reads each character one by one then it will be slow if you have large data.

[FONT=lucida console][color=Royalblue]Sub[/color] compareChar2()
[i][color=seagreen]'https://www.mrexcel.com/forum/excel-questions/1108363-vba-code-text-diff-between-two-columns.html[/color][/i]
[color=Royalblue]Dim[/color] i [color=Royalblue]As[/color] [color=Royalblue]Long[/color], j [color=Royalblue]As[/color] [color=Royalblue]Long[/color], n [color=Royalblue]As[/color] [color=Royalblue]Long[/color], k [color=Royalblue]As[/color] [color=Royalblue]Long[/color], y [color=Royalblue]As[/color] [color=Royalblue]Long[/color]
[color=Royalblue]Dim[/color] va

    Application.ScreenUpdating = [color=Royalblue]False[/color]

n = Range([color=brown]"A"[/color] & Rows.count).[color=Royalblue]End[/color](xlUp).Row
va = Range([color=brown]"A1:B"[/color] & n)
Range([color=brown]"C2:C"[/color] & n).Value = Range([color=brown]"B2:B"[/color] & n).Value

    [color=Royalblue]For[/color] i = [color=crimson]2[/color] [color=Royalblue]To[/color] UBound(va, [color=crimson]1[/color])
        j = Len(va(i, [color=crimson]1[/color])): y = Len(va(i, [color=crimson]2[/color]))
        [color=Royalblue]If[/color] y > j [color=Royalblue]Then[/color] va(i, [color=crimson]1[/color]) = va(i, [color=crimson]1[/color]) & WorksheetFunction.Rept([color=brown]" "[/color], y - j)
        tx = [color=brown]""[/color]
        [color=Royalblue]For[/color] k = [color=crimson]1[/color] [color=Royalblue]To[/color] y
          [color=Royalblue]If[/color] [color=Royalblue]Mid[/color](va(i, [color=crimson]1[/color]), k, [color=crimson]1[/color]) <> [color=Royalblue]Mid[/color](va(i, [color=crimson]2[/color]), k, [color=crimson]1[/color]) [color=Royalblue]Then[/color]
              [color=Royalblue]With[/color] Cells(i, [color=crimson]3[/color]).Characters(k, [color=crimson]1[/color])
              .Font.Color = vbRed
              tx = tx & .[color=Royalblue]Text[/color]
              [color=Royalblue]End[/color] [color=Royalblue]With[/color]
          [color=Royalblue]End[/color] [color=Royalblue]If[/color]
        [color=Royalblue]Next[/color] k
        Cells(i, [color=crimson]4[/color]) = tx
    [color=Royalblue]Next[/color] i
    
    Application.ScreenUpdating = [color=Royalblue]True[/color]
[color=Royalblue]End[/color] [color=Royalblue]Sub[/color][/FONT]

 

[Akila868]

Thanks @ Akuini. Really appreciate it. Still the code highlights the full word instead of the character that is newly added.

 

[Akuini]

Thanks @ Akuini. Really appreciate it. Still the code highlights the full word instead of the character that is newly added.

Here's the result I got, it isn't what you expected?

Column A	Column B
ABC$123.	ABCU123.	ABCU123.	U
DDD;889@	DDDL889P	DDDL889P	LP
Dustin	Duxtinx	Duxtinx	xx

<tbody>
</tbody>