View Single Post
  #9   Report Post  
Posted to microsoft.public.excel.programming
DJS DJS is offline
external usenet poster
 
Posts: 31
Default compare strings - highlight characters which are different

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



"jay" wrote:

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