Running a word VBA macro on text within two words - vba

Question

I have a macro that converts track changes to either underline or strikethrough and it does it on the entire word document. However, I would like it to run only on track changes only within a section of the document found between a first tag and a second tag (let's say between the words "Beginning" and "Ending"). I do not want this macro to make changes anywhere other than between these two tags. In other words, if I run this macro, only track changes within these two tags should be modified based on the macro and the rest of the document should keep its track changes intact.
Please let me know if you can help me modify this macro based on the above requirement.
Here's what I have but it runs on the entire document.
Sub FormatRevisions()
Dim rev As Revision, txt As String, r As Long, ran As Range
'First switch off TrackChanges, else each of your reformattings will become a revision again
ActiveDocument.TrackRevisions = False
'***Now cycle through revisions, identify type of change
For Each rev In ActiveDocument.Revisions
Select Case rev.Type
Case wdRevisionDelete
'secure "deleted" text as well as its position
txt = rev.Range.Text
r = rev.Range.Start
'accept the revision to make the markup disappear
rev.Accept
'now type the text formatted as strikethrough at the position of the old text
Set ran = ActiveDocument.Range(r, r)
With ran
.Text = txt
.Font.StrikeThrough = 1
End With
Case wdRevisionInsert
Set ran = rev.Range
'accept the revision to make the markup disappear
rev.Accept
'now type the text formatted as underlined at the position of the old text
ran.Font.Underline = 1
End Select
Next rev
End Sub

Answer 1

Try:
Sub FormatRevisions()
Application.ScreenUpdating = False
Dim Rvn As Revision, Rng As Range
'First switch off TrackChanges, else each of your reformattings will become a revision again
ActiveDocument.TrackRevisions = False
With ActiveDocument.Range
'Find the defined range
With .Find
.Text = "Beginning*Ending"
.MatchWildcards = True
.Execute
End With
If .Find.Found = True Then
'***Now cycle through revisions, identify type of change
For Each Rvn In .Revisions
With Rvn
Select Case .Type
Case wdRevisionDelete
Set Rng = .Range
'Reject the revision to make the markup disappear
.Reject
'now format the text as strikethrough
Rng.Font.StrikeThrough = True
Case wdRevisionInsert
Set Rng = .Range
'Accept the revision to make the markup disappear
.Accept
'now format the text as underlined
Rng.Font.Underline = wdUnderlineSingle
End Select
End With
Next
End If
End With
Application.ScreenUpdating = True
End Sub
The above approach also has the advantage of retaining the formatting of the deleted and added text.