This is the code i am working on
I want to maintain the track changes only for the exact word match.
Need to know the original word in track change so that we can track of which word is replace by which one
Code:
Sub RemoveShreeLipiDistortion()
Dim username As String
username = Application.username
Application.username = "RemoveShreeLipiDistortion"
Dim showrevisionsflag As Boolean
showrevisionsflag = ActiveWindow.View.ShowRevisionsAndComments
With ActiveWindow.View
.ShowRevisionsAndComments = False
.RevisionsView = wdRevisionsViewFinal
.Reviewers.Item("RemoveShreeLipiDistortion").Visible = True
End With
Dim objExcel As Object
Set objExcel = CreateObject("Excel.Application")
Set exWb = objExcel.Workbooks.Open(ActiveDocument.path + "\List of ShreeLipi Distortion (1).xlsx")
Dim counter As Integer
counter = 1000 'exWb.Worksheets(1).Rows.Count
Dim i As Integer
Dim oRng As Range
'For i = 250 To counter
For i = 2 To counter
If exWb.Worksheets(1).Range("A" & i) = "" Then
Exit For
End If
Set oRng = ActiveDocument.Range
ActiveDocument.TrackRevisions = False
With oRng.Find
.Text = Replace(exWb.Worksheets(1).Range("A" & i), "^", "^^")
.Replacement.Text = "Aardvark"
.MatchCase = True
.MatchWholeWord = True
.Execute Replace:=wdReplaceAll
End With
ActiveDocument.TrackRevisions = True
Set oRng = ActiveDocument.Range
With oRng.Find
.Text = "Aardvark"
.Replacement.Text = Replace(exWb.Worksheets(1).Range("B" & i), "^", "^^")
.MatchCase = True
.MatchWholeWord = True
.Execute Replace:=wdReplaceAll
End With
ActiveDocument.TrackRevisions = False
Set oRng = ActiveDocument.Range
With oRng.Find
.Text = "Aardvark"
.Replacement.Text = Replace(exWb.Worksheets(1).Range("A" & i), "^", "^^")
.MatchCase = True
.MatchWholeWord = False
.Execute Replace:=wdReplaceAll
End With
ActiveDocument.TrackRevisions = True
Next i
exWb.Close
Set exWb = Nothing
Set objExcel = Nothing
ActiveWindow.View.ShowRevisionsAndComments = showrevisionsflag
Application.username = username
End Sub