Highlight text difference in both columns in vba

Saria Ahmad

New Member
Joined
Feb 23, 2021
Messages
14
Office Version
  1. 2016
Platform
  1. Windows
Hi, I want to highlight the text difference in both columns. Idea is that if I have a text in both columns then, I want the matching cells on the same line. After bringing similar data on the same line. I want to highlight the difference of the columns which are little bit different from each other.
So far, I managed to bring the same cells on the same line but not the similar part. for the example I am attaching the file below.
Please share your valuable suggestions that how could I enter the loop on my provided VBA code. My code is as follow:
Please guide me. I want to entertain my 2nd code in the 1st code. How can I do this and what is the problem in my second code. as my columns are A and E and starting row is 8.
Sub CompareMacro()

Dim lr1 As Long
Dim lr2 As Long
Dim rng1 As Range
Dim rng2 As Range
Dim r As Long
lr1 = Cells(Rows.Count, "A").End(xlUp).Row
Set rng1 = Range("A8:A" & lr1)
lr2 = Cells(Rows.Count, "E").End(xlUp).Row
Set rng2 = Range("E8:E" & lr2)
r = 8
Do
If Cells(r, "A") = "" And Cells(r, "E") = "" Then Exit Do
If Cells(r, "A") <> "" And Cells(r, "E") <> "" Then
If Cells(r, "A") < Cells(r, "E") Then
Cells(r, "E").Insert Shift:=xlDown
Else
If Cells(r, "A") > Cells(r, "E") Then
Cells(r, "A").Insert Shift:=xlDown
End If
End If
End If
r = r + 1

Loop

End Sub




'This Sub compares the cells of opposite and colors
'the differences (each character)
'#########################################################

Sub IfEqualCells(LastRow, LastColumn)
Dim i As Integer
Dim j As Integer
Dim Length As Integer
i = 3
j = 6
Do Until j > LastRow
If Cells(j, i) = Cells(j, i + 6) Then
'Do nothing
Else 'format not-equal cells
If Len(Cells(j, i)) > Len(Cells(j, i + 6)) Then
Length = Len(Cells(j, i))
Else
Length = Len(Cells(j, i + 6))
End If

For K = 1 To Length
If Mid(Cells(j, i), K, 1) <> Mid(Cells(j, i + 6), K, 1) Then

Cells(j, i).Select 'left side
With Selection.Characters(Start:=K, Length:=1).Font
.Color = -16776961
End With
Cells(j, i + 6).Select 'right side
With Selection.Characters(Start:=K, Length:=1).Font
.Color = -16776961
End With
Else
Cells(j, i).Select 'left side
With Selection.Characters(Start:=K, Length:=1).Font
.Color = 0 'black
End With
Cells(j, i + 6).Select 'right side
With Selection.Characters(Start:=K, Length:=1).Font
.Color = 0 'black
End With
End If
Next K
End If

j = j + 1
Loop
End Sub
 

Attachments

  • Image3.png
    Image3.png
    32.5 KB · Views: 28

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.

Forum statistics

Threads
1,214,832
Messages
6,121,844
Members
449,051
Latest member
excelquestion515

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top