compare strings - highlight characters which are different

[Guest]

Hello~
I need some assistance in writing a macro which could compare each
alpha-numeric character in each row of column I & J and hightlight (via font
color) the characters of column I which are different, then move to the next
row. I need to run the macro on every row until i come to a blank row.
Any help greatly appreciated.

Thanks in advance,
Don

 

[stevebriz]

Are the string lengths the same in both column I and J for each row?

 

[Guest]

Yes, they should be 17 alpha-numeric characters.

Are the string lengths the same in both column I and J for each row?

 

[stevebriz]

DJS,
I don;t think it is possible to color characters with a different color
in the same cell.
so do you have another option?

 

[Andrew Taylor]

It's certainly possible to colour individual characters. The
following code will work on I1 and I2 as long as the values
are constant strings, not numbers or the results of formulas.

Option Explicit
Sub HighlightDifferences()
Dim r1 As Range, r2 As Range, i As Integer
Set r1 = Range("I1")
Set r2 = Range("J1")

For i = 1 To Len(r1.Value)
If Mid(r1.Value, i, 1) = Mid(r2.Value, i, 1) Then
r1.Characters(i, 1).Font.ColorIndex = xlAutomatic
Else
r1.Characters(i, 1).Font.Color = vbRed
End If
Next
End Sub

 

[stevebriz]

This is great to know Andrew...thankyou for making me aware of this

 

[Guest]

Thanks Andrew, I just added an "For Each, Next" loop to carry me through all
valid rows & a count of incorrect characters in an adjoining column and it
works great.
Much Appreciated!

 

[jay]

DJS:

Could you share the code you used?

I am also looking to compare two string... and I want to compare more than
I1 vs J1. I want to start by comparing A2 vs B2, then A3, B3 untill the last
value in A or B.

Pasting the difference in another column C is a nice addition.
Jay

 

[DJS]

Jay, here is my code.
Created a spreadsheet with a bunch of columns with data.
Name one of the column headers "Column_Header_Name" and make sure to have a
couple columns with data after it.
Then copy the code into your macro and run it.

start script
~~~~~~~~~~
Option Explicit
Function GetColLet(ColNumber As Variant) As String
GetColLet = Left(Cells(1, ColNumber).Address(False, False), _
1 - (ColNumber > 26))
End Function
Sub VIN_Character_Count_and_Highlight()
' The Following function compares each alpha-numeric character of
' a column and adjacent column
' and highlights the differences in red in the first Column
' The CHR COUNT Column will be displayed in Red & Bold if first column
' is less than 17 Charcters in length.

Dim rng As Range, cell As Range, r1 As Range, r2 As Range, i As Integer, c
As Integer, colNum As Variant, colLtr As Variant, myRowRng As Range,
mySearchString As String

Set myRowRng = Rows(1) 'first row
mySearchString = "Column_Header_Name" 'search for this string
colNum = Application.Match(mySearchString, myRowRng, 0)
'colLtr = GetColLet(colNum)
Set rng = Range(Cells(2, colNum), Cells(2, colNum).End(xlDown))

MsgBox "I am going to compare the 2 columns (Column " & GetColLet(colNum) &
" and " & GetColLet(colNum + 1) & ") of this document" & Chr(13) & "for the
following Range: " & rng.Address & "." & Chr(13) & Chr(13) & "The Following
function compares each alpha-numeric character of the first column &" &
Chr(13) & "adjacent column and highlights the differences in red in the first
column." & Chr(13) & "The VIN CHR COUNT Column indicates the qty of
characters which did not match. " & Chr(13) & "The number will be displayed
in Red & Bold if REG VIN is less than 17 Charcters in length." & Chr(13) &
Chr(13)

Cells(1, colNum).Offset(0, 3).Value = "VIN CHR COUNT"
Cells(1, colNum).Offset(0, 4).Value = "Reg VIN (Column: " &
GetColLet(colNum) & ") CHR Length"
Cells(1, colNum).Offset(0, 5).Value = "OBD VIN (Column: " & GetColLet(colNum
+ 1) & ") CHR Length"

For Each cell In rng
Set r1 = cell
Set r2 = cell.Offset(0, 1)

If Len(r1) <> Len(r2) Then
c = (Len(r1) - Len(r2))
r2.Offset(0, 2).Value = c
r2.Offset(0, 2).Font.Color = vbRed
r2.Offset(0, 2).Font.Bold = True
End If

c = 0
r2.Offset(0, 3).Value = Len(r1)
r2.Offset(0, 4).Value = Len(r2)

For i = 1 To Len(r1.Value)
If Mid(r1.Value, i, 1) = Mid(r2.Value, i, 1) Then
r1.Characters(i, 1).Font.ColorIndex = xlAutomatic
Else
r1.Characters(i, 1).Font.Color = vbRed
c = (c + 1)
r2.Offset(0, 2).Value = c
End If
Next i
Next
End Sub


~~~~~~~~~
end script