Saria Ahmad
New Member
- Joined
- Feb 23, 2021
- Messages
- 14
- Office Version
- 2016
- Platform
- 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
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