Find text only in Changes

[Huber57]

All,

I have a 600 page document and there are changes scattered through out it.
'Track Changes' is on so these changes are highlighted in a different color.
I would like to be able to 'find' works when I search the document (using the
Find function). Is there a way to limit the search to strings that are
changed?

Sincerely,

Doug

 

[Jay Freedman]

All,

I have a 600 page document and there are changes scattered through
out it. 'Track Changes' is on so these changes are highlighted in a
different color. I would like to be able to 'find' works when I
search the document (using the Find function). Is there a way to
limit the search to strings that are changed?

Sincerely,

Doug

The fact that the changes are highlighted in color doesn't do you any good
at all, because there's no way to look for that (it isn't really font
formatting, just something the Track Changes feature applies).

The following macro will look through the changes (except the deletions) to
find the next occurrence of specified text. It completely ignores formatting
(bold, italic, etc.) -- it would take a fair bit more programming to handle
that.

Read http://www.gmayor.com/installing_macro.htm if needed.

Sub FindInTrackedChanges()
Dim FindWhat As String
Dim oRev As Revision
Dim oRg As Range
Dim pos As Long
Dim foundOne As Boolean
Dim i

' set a range from the end of the selection
' to the end of the document
Set oRg = ActiveDocument.Range
oRg.Start = Selection.End

' get the search term
FindWhat = InputBox("Enter text to find:", "Find In Changes")
If Len(FindWhat) = 0 Then Exit Sub

' look through all tracked changes except deletions
For i = 1 To oRg.Revisions.Count
Set oRev = oRg.Revisions(i)
If oRev.Type <> wdRevisionDelete Then
pos = InStr(oRev.Range.Text, FindWhat)
If pos > 0 Then
foundOne = True
' move the selection to the search term
Selection.Start = oRev.Range.Start + pos - 1
Selection.End = Selection.Start + Len(FindWhat)
Exit For
End If
End If
Next

If Not foundOne Then
MsgBox "No more occurrences.", , "Find In Changes"
End If
End Sub

--
Regards,
Jay Freedman
Microsoft Word MVP
Email cannot be acknowledged; please post all follow-ups to the newsgroup so
all may benefit.

 

[Huber57]

Jay,

The code is great. I appreciate the work you put into it. As i read
through it, is it supposed to be able to 'jump' to the next found item or
just highlight the ones found?

Thanks again,

Doug

 

[Jay Freedman]

It will jump to the next occurrence, just like clicking the Find Next
button in the Find dialog.

 

[Huber57]

Jay,

It is not working that way when I run the macro. If I search for 'Doug' it
will highlight the first occurence of it, but does not jump to it. Once I
find the hightlighted 'Doug', if I run the macro again, it doesn't jump to
the next occurence, it stays on the originally highlighted word.

Any thoughts on how i may be installing it wrong? (P.S., I followed the
instructions on the link you posted - which were great).

Sincerely,

Doug

 

[Jay Freedman]

Ah... poor testing. I only used a one-page document, so I didn't
notice that it wouldn't scroll to an occurrence that was off the
screen. I also neglected the possibility that the search term could
appear more than once in the same revision. I hope this revised macro
will take care of those problems.

Sub FindInTrackedChanges()
Dim FindWhat As String
Dim oRev As Revision
Dim pos As Long
Dim foundOne As Boolean
Dim i As Long
Dim currStart As Long

' get the search term
FindWhat = InputBox("Enter text to find:", "Find In Changes")
If Len(FindWhat) = 0 Then Exit Sub

currStart = Selection.Start

' look through all tracked changes except deletions
For i = 1 To ActiveDocument.Revisions.Count
Set oRev = ActiveDocument.Revisions(i)
If (oRev.Type <> wdRevisionDelete) And _
(ActiveDocument.Revisions(i).Range.End > _
Selection.Start) Then
pos = InStr(max(1, Selection.End - oRev.Range.Start + 1), _
oRev.Range.Text, FindWhat)
While pos > 0
foundOne = True
' move the selection to the search term
Selection.Start = oRev.Range.Start + pos - 1
Selection.End = Selection.Start + Len(FindWhat)
ActiveWindow.ScrollIntoView Selection.Range, True
Exit For
Wend
End If
Next

If Not foundOne Then
MsgBox "No more occurrences.", , "Find In Changes"
End If
End Sub

Private Function max(a As Long, b As Long)
If a > b Then
max = a
Else
max = b
End If
End Function

 

[Huber57]

Jay,

That is awesome. THanks much for your help.

Sincerely,

Doug