VBA - Change color of modified text

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

You can find answers here :http://stackoverflow.com/questions/4668410/how-do-i-get-the-old-value-of-a-changed-cell-in-excel-vba — Fnaxiom, May 11 '16 at 13:46

Gary's Student · Answer 1 · 2016-05-11T13:59:10.953

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.

edited May 11 '16 at 13:59

answered May 11 '16 at 13:52

Gary's Student

95,722
10
59
99

score 2 · Answer 2 · answered May 11 '16 at 13:53

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.

The code is good.............. but may have trouble retaining the old values of all the cells in the range of interest with only one global. — Gary's Student, May 11 '16 at 14:03

score 1 · Answer 3 · answered May 11 '16 at 13:51

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.

Looks good............should you not refresh `sOldValue` somewhere in the code ?? — Gary's Student, May 11 '16 at 13:54
That's handled in the `Worksheet_SelectionChange` event. After the cell has been updated pressing enter will move to the next cell and capture the old value of that cell. — Darren Bartrup-Cook, May 11 '16 at 15:02

score 1 · Accepted Answer · answered May 11 '16 at 14:29

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

Thanks! It does work although if I change something in the beginning of the cell it will change the color of the characters on the right side. But anyway it does the purpose. Thanks a lot! — peetman, May 11 '16 at 14:45

score 0 · Answer 5 · answered May 11 '16 at 15:08

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

VBA - Change color of modified text

5 Answers5