This source code file is available for download here: ExcelDiff.bas(~2 KB)
1: | Attribute VB_Name = "ExcelDiff" |
2: | Public Sub DiffCell(OldValue As String, NewValue As String, cell As Range) |
3: | Dim commands As String |
4: | commands = Diff(OldValue, NewValue) |
5: | |
6: | ' make unprintable characters visible |
7: | commands = Replace(commands, DIFF_INSERT & Chr(13) & DIFF_INSERT & Chr(10), DIFF_INSERT & "\" & DIFF_INSERT & "n") |
8: | commands = Replace(commands, DIFF_DELETE & Chr(13) & DIFF_DELETE & Chr(10), DIFF_DELETE & "\" & DIFF_DELETE & "n") |
9: | commands = Replace(commands, DIFF_INSERT & Chr(13), DIFF_INSERT & "\" & DIFF_INSERT & "r") |
10: | commands = Replace(commands, DIFF_DELETE & Chr(13), DIFF_DELETE & "\" & DIFF_DELETE & "r") |
11: | |
12: | Dim text As String |
13: | Dim i As Integer |
14: | text = "" |
15: | For i = 2 To Len(commands) Step 2 |
16: | text = text & Mid(commands, i, 1) |
17: | Next |
18: | |
19: | cell.Font.ColorIndex = xlAutomatic |
20: | cell.Interior.ColorIndex = xlAutomatic |
21: | cell.NumberFormat = "@" |
22: | cell.FormulaR1C1 = text |
23: | If Left(cell.text, 6) = "######" Then |
24: | cell.NumberFormat = "General" |
25: | End If |
26: | |
27: | i = 1 |
28: | While commands <> "" |
29: | Select Case Mid(commands, 1, 1) |
30: | Case DIFF_INSERT |
31: | With cell.Characters(Start:=i, Length:=1).Font |
32: | .ColorIndex = 5 |
33: | .FontStyle = "Bold" |
34: | .Underline = True |
35: | ' TUNE: .size = 11 |
36: | End With |
37: | |
38: | Case DIFF_DELETE |
39: | With cell.Characters(Start:=i, Length:=1).Font |
40: | .Strikethrough = True |
41: | .FontStyle = "Bold" |
42: | ' TUNE: .size = 11 |
43: | .ColorIndex = 3 |
44: | End With |
45: | |
46: | Case DIFF_COPY |
47: | ' default format |
48: | End Select |
49: | i = i + 1 |
50: | commands = Mid(commands, 3) |
51: | Wend |
52: | End Sub |