Highlight table cells in Word 2010 that have tracked changes - vba

Question

I'm looking to highlight table cells with tracked changes.
Here is my VBA code:
Sub HiliteChanges()
Dim oTable As Table
Dim oColumn As Column
Dim oCell As Cell
Dim oRange As Range
Dim numRevs As Integer
Dim tableIndex, rowIndex, cellIndex As Integer
For tableIndex = 1 To ActiveDocument.Tables.Count
For rowIndex = 1 To ActiveDocument.Tables(tableIndex).Rows.Count
For cellIndex = 1 To ActiveDocument.Tables(tableIndex).Rows(rowIndex).Cells.Count
numRevs = ActiveDocument.Tables(tableIndex).Rows(rowIndex).Cells(cellIndex).Range.Revisions.Count
Debug.Print tableIndex, rowIndex, cellIndex, numRevs
If numRevs > 0 Then
ActiveDocument.Tables(tableIndex).Rows(rowIndex).Cells(cellIndex).Shading.BackgroundPatternColor = wdColorBlueGray
End If
Next
Next
Next
End Sub
What it ends up doing is highlighting the entire row, even if only one cell in a row is changed.
I made a change in a table with 3 rows and 6 columns. The change was in the fourth column of the first row. I turned off Track Changes prior to running the script. This was the output:
1 1 1 1
1 1 2 1
1 1 3 1
1 1 4 1
1 1 5 1
1 1 6 1
1 2 1 0
1 2 2 0
1 2 3 0
1 2 4 0
1 2 5 0
1 2 6 0
1 3 1 0
1 3 2 0
1 3 3 0
1 3 4 0
1 3 5 0
1 3 6 0
So it looks like every cell in the first row has a change, but it doesn't. There was only one cell with a change.
Is there a way to highlight only the cells that have changes? (Obviously my way is flawed in some way, but I can't see where.)

Answer 1

When you check for revisions, don't include the "end of cell" marker in the checked range. Don't ask me why that works...
Sub HiliteChanges()
Dim oTable As Table
Dim oColumn As Column, oRow As Row, rng As Range
Dim oCell As Cell
Dim oRange As Range
Dim numRevs As Integer
Dim tableIndex, rowIndex, cellIndex As Integer
For tableIndex = 1 To ActiveDocument.Tables.Count
Set oTable = ActiveDocument.Tables(tableIndex)
For rowIndex = 1 To oTable.Rows.Count
Set oRow = oTable.Rows(rowIndex)
For cellIndex = 1 To oRow.Cells.Count
Set oCell = oRow.Cells(cellIndex)
Set rng = oCell.Range
'don't include the "end of cell" marker in the checked range
rng.MoveEnd wdCharacter, -1
numRevs = rng.Revisions.Count
Debug.Print tableIndex, rowIndex, cellIndex, numRevs
If numRevs > 0 Then
oCell.Shading.BackgroundPatternColor = wdColorBlueGray
End If
Next
Next
Next
End Sub