VBA - Change color of modified text - vba

Question

I have this code that changes the color of the text in a cell if it is modified. However I was looking into something that only changes the color of modified text inside the cell. For example I have in cell A1 = "This cell" and when I change it to "This cell - this is new text" I would like just to change the color of "- this is new text"
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A1:A100")) Is Nothing Then
If Target.Font.ColorIndex = 3 Then
Target.Font.ColorIndex = 5
Else
Target.Font.ColorIndex = 3
End If
End If
End Sub
Thanks

Answer 1

Here's what I put together:
Dim oldString$, newString$
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A1:A100")) Is Nothing Then
newString = Target.Value
If Target.Font.ColorIndex = 3 Then
Target.Font.ColorIndex = 5
Else
Target.Font.ColorIndex = 3
End If
End If
Debug.Print "New text: " & newString
color_New_Text oldString, newString, Target
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
If Not Intersect(Target, Range("A1:A100")) Is Nothing Then
oldString$ = Target.Value
Debug.Print "Original text: " & oldString$
End If
End Sub
Sub color_New_Text(ByVal oldString As String, ByVal newString As String, ByVal theCell As Range)
Dim oldLen&, newLen&, i&, k&
oldLen = Len(oldString)
newLen = Len(newString)
Debug.Print newString & ", " & oldString
For i = 1 To newLen
If Mid(newString, i, 1) <> Mid(oldString, i, 1) Then
Debug.Print "different"
Debug.Print theCell.Characters(i, 1).Text
If theCell.Characters(i, 1).Font.ColorIndex = 3 Then
theCell.Characters(i, 1).Font.ColorIndex = 5
Else
theCell.Characters(i, 1).Font.ColorIndex = 3
End If
End If
Next i
End Sub
It's two global variables, a Worksheet_SelectionChangeand Worksheet_Changeto get the strings.

Answer 2

It is laborious:
detect that a cell has changed in the range of interest
use UnDo to get the original contents
use ReDo to get the new contents
compare them to get the changed characters
use the Characters property of the cell to format the new characters
I would use UnDo to avoid keeping a static copy of each of the 100 cells.

Answer 3

using the tip from Gary's Student, I retain the old value of cell and compare with the new value. Then use the lenght to get the 'difference' and color the 'characters'. Here's the modification:
Option Explicit
Public oldValue As Variant
Public Sub Worksheet_SelectionChange(ByVal Target As Range)
oldValue = Target.Value
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim oldColor
If Not Intersect(Target, Range("A1:A100")) Is Nothing Then
If Target.Value <> oldValue Then
oldColor = Target.Font.ColorIndex
Target.Characters(Len(oldValue) + 1, Len(Target) - Len(oldValue)).Font.ColorIndex = IIf(oldColor = 3, 5, 3)
End If
End If
End Sub
P.S. Sorry my english

Answer 4

This will change the font, but it's not perfect. Seems if you have different font colours in the same cell then Target.Font.ColorIndex returns NULL so it only works on the first change.
Option Explicit
Dim sOldValue As String
Private Sub Worksheet_Change(ByVal Target As Range)
Dim sNewValue As String
Dim sDifference As String
Dim lStart As Long
Dim lLength As Long
Dim lColorIndex As Long
On Error GoTo ERROR_HANDLER
If Not Intersect(Target, Range("A1:A100")) Is Nothing Then
sNewValue = Target.Value
sDifference = Replace(sNewValue, sOldValue, "")
lStart = InStr(sNewValue, sDifference)
lLength = Len(sDifference)
If Target.Font.ColorIndex = 3 Then
lColorIndex = 5
Else
lColorIndex = 3
End If
Target.Characters(Start:=lStart, Length:=lLength).Font.ColorIndex = lColorIndex
End If
On Error GoTo 0
Exit Sub
ERROR_HANDLER:
Select Case Err.Number
'I haven't added error handling - trap any errors here.
Case Else
MsgBox "Error " & Err.Number & vbCr & _
" (" & Err.Description & ") in procedure Sheet1.Worksheet_Change."
End Select
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("A1:A100")) Is Nothing Then
sOldValue = Target.Value
End If
End Sub
Edit: It will only work with a continuous string. Maybe can change to look at each character in sOldValue and sNewValue and change colour as required.

Answer 5

Try with below
Private Sub Worksheet_Change(ByVal Target As Range)
Dim newvalue As String
Dim olvalue As String
Dim content
Application.EnableEvents = False
If Not Intersect(Target, Range("A1:A100")) Is Nothing Then
If Target.Font.ColorIndex <> -4105 Or IsNull(Target.Font.ColorIndex) = True Then
newvalue = Target.Value
Application.Undo
oldvalue = Target.Value
Content = InStr(newvalue, Replace(newvalue, oldvalue, ""))
Target.Value = newvalue
With Target.Characters(Start:=Content, Length:=Len(newvalue)).Font
.Color = 5
End With
Else
Target.Font.ColorIndex = 3
End If
End If
Application.EnableEvents = True
End Sub