Add side comments that point to specific words - vba

Question

I have 2 word documents:
Document to review for wrong words. Sample sentence in document: Winnie the poop is cute.
Document with a matrix that contains wrong words to search for, and a suggestion.
Example: Term=Winnie the poop Suggestion=Correct spelling is Winnie the pooh.
At this point my code adds a comment, but it highlights the whole sentence (Winnie the poop is cute). How do I link the suggestion to the specific term that is wrong (Winnie the poop)?
Sub Search4WrongWords()
Dim MatrixCounter As Integer 'Counter to search for all terms in the Matrix
Dim DocToValidate As Word.Document 'Document to validate and search for wrong words
Dim MaxWordsInMatrix As Integer 'Total rows in Matrix
Const ColumnWithTerm = 2 'Matrix wrong terms Example: Winnie the Poop
Const ColumnWithSuggestion = 3 'Matrix suggested term. Example: Winnie The Pooh
MatrixCounter = 0
DocumentPath = "C:\Folder\File_to_validate.docx" 'File to validate for wrong words
MatrixPath = "C:\Folder\Matrix_with_suggestions.docx" 'Matrix with terms & suggestions
Set MatrixDoc = Documents.Open(MatrixPath) 'File path is provided by user
Set DocToValidate = Documents.Open(DocumentPath) 'File path is provided by user
MaxWordsInMatrix = MatrixDoc.Tables(1).Rows.Count 'Total rows in matrix
For MatrixCounter = 2 To MaxWordsInMatrix 'counter =2 to avoid reading matrix header row
With DocToValidate.range.Find
.Text = Trim(LCase(Left(MatrixDoc.Tables(1).Rows(MatrixCounter).Cells(ColumnWithTerm).range.Text, Len(MatrixDoc.Tables(1).Rows(MatrixCounter).Cells(ColumnWithTerm).range.Text) - 2)))
.Format = True
.MatchCase = False
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.NoProofing = False
Do While .Execute(Forward:=True) = True
suggestion = MatrixDoc.Tables(1).Rows(MatrixCounter).Cells(ColumnWithSuggestion).range.Text
DocToValidate.Comments.Add DocToValidate.range, Text:=suggestion
Loop 'do while
End With 'DocToValidate
Next 'MatrixCounter
End Sub

Answer 1

When you execute a find the range, or selection, is redefined to the found match. This is useful if you are then going to further process the found range. In most circumstances it is possible to use the built-in range object of a document.
The exception to this is where you need to use the found range as an input parameter for another operation, as you do with adding a comment. In your code when you use DocToValidate.range as the anchor for the comment instead of referring to the found match it refers to the entire document.
You can overcome this by using an object variable for the range, as below.
Sub Search4WrongWords()
Dim MatrixCounter As Integer 'Counter to search for all terms in the Matrix
Dim DocToValidate As Word.Document 'Document to validate and search for wrong words
Dim MaxWordsInMatrix As Integer 'Total rows in Matrix
Const ColumnWithTerm = 2 'Matrix wrong terms Example: Winnie the Poop
Const ColumnWithSuggestion = 3 'Matrix suggested term. Example: Winnie The Pooh
MatrixCounter = 0
DocumentPath = "C:\Folder\File_to_validate.docx" 'File to validate for wrong words
MatrixPath = "C:\Folder\Matrix_with_suggestions.docx" 'Matrix with terms & suggestions
Set MatrixDoc = Documents.Open(MatrixPath) 'File path is provided by user
Set DocToValidate = Documents.Open(DocumentPath) 'File path is provided by user
MaxWordsInMatrix = MatrixDoc.Tables(1).Rows.Count 'Total rows in matrix
Dim findRange As Word.Range
Dim suggestion As String
For MatrixCounter = 2 To MaxWordsInMatrix 'counter =2 to avoid reading matrix header row
Set findRange = DocToValidate.Range 'necessary to ensure that the full document is being searched with each iteration
With findRange.Find
.Text = Trim(LCase(Left(MatrixDoc.Tables(1).Rows(MatrixCounter).Cells(ColumnWithTerm).Range.Text, Len(MatrixDoc.Tables(1).Rows(MatrixCounter).Cells(ColumnWithTerm).Range.Text) - 2)))
.MatchCase = False
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.NoProofing = False
.Wrap = wdFindStop 'stops find at the end of the document
Do While .Execute(Forward:=True) = True
'findRange has now been redefined to the found match
suggestion = MatrixDoc.Tables(1).Rows(MatrixCounter).Cells(ColumnWithSuggestion).Range.Text
DocToValidate.Comments.Add findRange, Text:=suggestion
findRange.Collapse wdCollapseEnd 'necessary to avoid getting into endless loop
Loop 'do while
End With 'findRange.Find
Next 'MatrixCounter
End Sub