Macro to highlight changes

SoberGuy · October 23rd, 2008, 06:21 PM

Due to ridiculous work requirements, I have to highlight any insertions in a Word document. Track changes will change font color, but will not highlight text, so I need a macro. What I have is the following, but it always hangs up and never completes. I've tested in several documents (after doing a compare and merge) and there doesn't seem to be any rhyme or reason for the stopping points. Any thoughts or advice?

Sub Macro10()
Dim myRev As Object
Dim i As Integer
    With Options
        .InsertedTextMark = wdInsertedTextMarkBold
        .InsertedTextColor = wdBlue
        .DeletedTextMark = wdDeletedTextMarkStrikeThrough
        .DeletedTextColor = wdRed
        .RevisedPropertiesMark = wdRevisedPropertiesMarkNone
        .RevisedPropertiesColor = wdByAuthor
        .RevisedLinesMark = wdRevisedLinesMarkOutsideBorder
        .RevisedLinesColor = wdAuto
        .CommentsColor = wdByAuthor
        .RevisionsBalloonPrintOrientation = wdBalloonPrintOrientationPreserve
    End With
WordBasic.ShowComments
WordBasic.ShowFormatting
For i = 1 To 1500
On Error Resume Next
Set myRev = Selection.NextRevision
If Not (myRev Is Nothing) Then
    If myRev.Type = wdRevisionInsert Then Selection.Range.HighlightColorIndex = wdYellow
    If myRev.Type = wdRevisionInsert Then Selection.Range.Revisions.AcceptAll
End If
Next i
End Sub

Shasur · October 24th, 2008, 01:05 AM

Hi

Here is a hint

Code:

Sub HLight_Inserts()

Dim i As Long
Dim iMax As Long
Dim bAccept As Boolean ' Set this to True if you want to accept revision



ActiveDocument.TrackRevisions = False
' ----------------------------
' Set bAccept  = True if Insertions to be Accepted
' ----------------------------
bAccept = False
' ----------------------------

iMax = ActiveDocument.Revisions.Count
For i = 1 To iMax
    If i > iMax Then Exit For
    Debug.Print ActiveDocument.Revisions(i).Type
    If ActiveDocument.Revisions(i).Type = wdRevisionInsert Then
        ActiveDocument.Revisions(i).Range.HighlightColorIndex = wdYellow
        If bAccept = True Then
            ActiveDocument.Revisions(i).Accept
            i = i - 1
            iMax = iMax - 1
        End If
    End If
Next i
ActiveDocument.TrackRevisions = True

End Sub

Cheers
Shasur

http://www.dotnetdud.blogspot.com

VBA Tips & Tricks (http://www.vbadud.blogspot.com)

SoberGuy · October 24th, 2008, 11:46 AM

Shasur, thanks much!

While it was incredibly helpful, I do hope maybe you can provide some additional support.

I think this may be a problem with Word itself, so I don't know if there's a workaround. These documents have tables in them as well. Neither your procedure nor mine will move through a table if a row or column has been deleted. Trying it manually, it gets to a deleted a row or column, and sees that as the end of document, and asks if you'd like to return to the top. Fortunately, these are closer to the end than the beginning, but still, it's a hassle to highlight manually. Any thoughts on this?

*Edit.... It went through my first table just fine, which had deleted columns. The second table, it would do anything, not even highlight changes prior to a deleted column or row. The only things between the stopping point and the table are deleted text (which it has ignored on all other pages) and format changes (same ones ignored on previous changes). It did state an issue with:
Debug.Print ActiveDocument.Revisions(i).Type

Also, the document is 51 pages with changes tracked. Your code moved through 49 pages........in ten minutes. Do you think there may be a way to speed it up at all? If not, it's still much, much faster than doing it by hand.

Thanks again!