Sub ChangesInRed() 
     'Makes font color red for all cells marked as 'changed' by Tools...Track Changes _
    feature The Tools...Track Changes feature must be turned on For the workbook being _ 
    examined Macro must be In a different workbook than the one being examined Workbook _ 
    being examined will be saved when the macro begins executing 
    Dim cel As Range 
    Dim wsName As String, celAddr As String 
    Dim ws As Worksheet 
    Dim wb As Workbook 
    Set wb = ActiveWorkbook 
    With wb 
         'Test if macro is being applied to ThisWorkbook
        If .Name = ThisWorkbook.Name Then 
            MsgBox Title:="Error message", prompt:="This macro will not work on " & _ 
            "the same workbook that contains the macro." & Chr(10) & _ 
            "Please click on a cell in a different workbook using the " & _ 
            "Track Changes feature" 
            Exit Sub 
        End If 
         'Test if Track Changes feature is turned off in Shared workbook
        If .KeepChangeHistory = False Then Goto errhandler 
        Application.ScreenUpdating = False 
        Application.DisplayAlerts = False 
         
         'Display all changes as list on History worksheet
         '(which will be the last one in the workbook)
        On Error Goto errhandler 
         'If workbook hasn't been saved after initiating the TrackChanges feature
         'History worksheet can't be opened
        .Save 
        .HighlightChangesOptions When:=xlAllChanges, Who:="Everyone" 
        .ListChangesOnNewSheet = True 
        .HighlightChangesOnScreen = True 
        .Worksheets(.Worksheets.Count).Columns("F:G").Copy 
    End With 
     
     'Paste list of changes in new sheet in this workbook
    ThisWorkbook.Activate 
    ThisWorkbook.Worksheets.Add 
    Set ws = ActiveSheet 
    ws.Range("F1").PasteSpecial 
    Application.CutCopyMode = False 
     
     'Go through list of changes and color each affected cell red
    For Each cel In Range(Cells(2, 6), Cells(65536, 6).End(xlUp)).Cells 
        wsName = cel.Value 
        celAddr = cel.Offset(0, 1).Value 
        wb.Worksheets(wsName).Range(celAddr).Font.ColorIndex = 3 'Mark changes in red
    Next cel 
     
    ActiveSheet.Delete 'Delete the list of changes from this workbook
    wb.Activate 
     'Don't display list of changes in separate worksheet
    wb.ListChangesOnNewSheet = False 
    Application.DisplayAlerts = True 
    Application.ScreenUpdating = True 
    On Error Goto 0 
    Exit Sub 
     
errhandler: 
    MsgBox Title:="Error message", prompt:="Track changes feature must " & _ 
    "be turned on for active workbook" 
    On Error Goto 0 
    Application.DisplayAlerts = True 
    Application.ScreenUpdating = True 
    Exit Sub 
End Sub