Compare strings and return difference and position

K

kabimeister

Hi

I have two Macros:
The fisrt compares two strings in Column B (Entry) and C (Corrected),
returns the string in column B to Column D (Highlight) and highlights
in blue the characters in column B that are different to those in
column C (Code and example follow):

Sub comp()

RowCount = 1
Do While Range("B" & RowCount) <> ""
If Range("B" & RowCount) <> Range("C" & RowCount) Then

'copy cell B to column D
Range("D" & RowCount).Value = _
Range("B" & RowCount).Value
'highlight characters that are different
For i = 1 To Len(Range("D" & RowCount))
If Mid(Range("B" & RowCount), i, 1) <> _
Mid(Range("C" & RowCount), i, 1) Then

Range("D" & RowCount). _
Characters(Start:=i, Length:=1).Font _
.ColorIndex = 41
End If
Next i
End If


ID Entry Corrected Difference
1 IDAMA OBAMA IDAMA
2 6IMD 61MD 6IMD
3 9999ZM36 9999ZM35 9999ZM36
4 YYS3WDE YYS3WOE YYS3WDE


The second macro returns to column E (Difference) the highlighted
characters in the string in column D (Highlight) again code and
example below:

Sub Diff()

'
RowCount = 1
Do While Range("B" & RowCount) <> ""
If Range("B" & RowCount) <> Range("C" & RowCount) Then

CompareStr = “”
For i = 1 To Len(Range("D" & RowCount))
If Mid(Range("B" & RowCount), i, 1) <> _
Mid(Range("C" & RowCount), i, 1) Then

CompareStr = CompareStr & Mid(Range("B" & RowCount), i, 1)
End If
Next i
Range("E" & RowCount) = CompareStr
End If
RowCount = RowCount + 1
Loop
End Sub

ID Entry Corrected Highlight Difference
1 IDAMA OBAMA IDAMA ID
2 6IMD 61MD 6IMD I
3 9999ZM36 9999ZM35 9999ZM36 6
4 YYS3WDE YYS3WOE YYS3WDE D

I want to combine these two macros so they run as a single macro and
also return the postitions of the characters that are differrent to
Column F, for example:

ID Entry Corrected Highlight Difference Position
1 IDAMA OBAMA IDAMA ID 1,2
2 6IMD 61MD 6IMD I 2
3 9999ZM36 9999ZM35 9999ZM36 6 8
4 YYS3WDE YYS3WOE YYS3WDE D 6


Any help would be much appreciated.

Thanks.
 
B

Bernie Deitrick

Try the sub below.

HTH,
Bernie
MS Excel MVP

Sub CompCombined()

RowCount = 1
Do While Range("B" & RowCount) <> ""
If Range("B" & RowCount) <> Range("C" & RowCount) Then

'copy cell B to column D
Range("D" & RowCount).Value = _
Range("B" & RowCount).Value
'highlight characters that are different
For I = 1 To Len(Range("D" & RowCount))
If Mid(Range("B" & RowCount), I, 1) <> _
Mid(Range("C" & RowCount), I, 1) Then

Range("D" & RowCount). _
Characters(Start:=I, Length:=1).Font _
.ColorIndex = 41
End If
Next I

CompareStr = ""
Position = ""
For I = 1 To Len(Range("D" & RowCount))
If Mid(Range("B" & RowCount), I, 1) <> _
Mid(Range("C" & RowCount), I, 1) Then

CompareStr = CompareStr & Mid(Range("B" & RowCount), I, 1)
Position = Position & IIf(Position <> "", ",", "") & I
End If
Next I
Range("E" & RowCount) = CompareStr
Range("F" & RowCount) = Position

End If
RowCount = RowCount + 1
Loop

End Sub


Hi

I have two Macros:
The fisrt compares two strings in Column B (Entry) and C (Corrected),
returns the string in column B to Column D (Highlight) and highlights
in blue the characters in column B that are different to those in
column C (Code and example follow):

Sub comp()

RowCount = 1
Do While Range("B" & RowCount) <> ""
If Range("B" & RowCount) <> Range("C" & RowCount) Then

'copy cell B to column D
Range("D" & RowCount).Value = _
Range("B" & RowCount).Value
'highlight characters that are different
For i = 1 To Len(Range("D" & RowCount))
If Mid(Range("B" & RowCount), i, 1) <> _
Mid(Range("C" & RowCount), i, 1) Then

Range("D" & RowCount). _
Characters(Start:=i, Length:=1).Font _
.ColorIndex = 41
End If
Next i
End If


ID Entry Corrected Difference
1 IDAMA OBAMA IDAMA
2 6IMD 61MD 6IMD
3 9999ZM36 9999ZM35 9999ZM36
4 YYS3WDE YYS3WOE YYS3WDE


The second macro returns to column E (Difference) the highlighted
characters in the string in column D (Highlight) again code and
example below:

Sub Diff()

'
RowCount = 1
Do While Range("B" & RowCount) <> ""
If Range("B" & RowCount) <> Range("C" & RowCount) Then

CompareStr = “”
For i = 1 To Len(Range("D" & RowCount))
If Mid(Range("B" & RowCount), i, 1) <> _
Mid(Range("C" & RowCount), i, 1) Then

CompareStr = CompareStr & Mid(Range("B" & RowCount), i, 1)
End If
Next i
Range("E" & RowCount) = CompareStr
End If
RowCount = RowCount + 1
Loop
End Sub

ID Entry Corrected Highlight Difference
1 IDAMA OBAMA IDAMA ID
2 6IMD 61MD 6IMD I
3 9999ZM36 9999ZM35 9999ZM36 6
4 YYS3WDE YYS3WOE YYS3WDE D

I want to combine these two macros so they run as a single macro and
also return the postitions of the characters that are differrent to
Column F, for example:

ID Entry Corrected Highlight Difference Position
1 IDAMA OBAMA IDAMA ID 1,2
2 6IMD 61MD 6IMD I 2
3 9999ZM36 9999ZM35 9999ZM36 6 8
4 YYS3WDE YYS3WOE YYS3WDE D 6


Any help would be much appreciated.

Thanks.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

OFFSET LOOKUP function in VBA? 9
retrieve data from an .aspx web page 5
Help Change existing Code 6
Run-Time Error "9". Subscript out of range 3
Select Case 6
ERROR 424" OBJECT REQUIRED 1
For without Next error 3
Changing rows 2

Top