Import MS-Excel columns to MS-Word as Comments - vba

Question

Situation:
I am trying to search through a word document for Keyword/IDs contained in an excel, and add comments from the spreadsheet to the word document for every occurrence of the Keyword/IDs then save. The sample code I have runs through the list of Keyword/IDs, but only comments the first occurrence
Give:
The word file is located at C:\Test\ACBS.docx and the excel executing the VBA macro is located separately. In the Excel the search term variable “FindWord” is in column A , and the comment is the variable “CommentWord” in column B.
Problem:
How can I get this to search through the entire word document and comment each occurrence of the Keyword/IDs?
Code:
Sub Comments_Excel_to_Word()
'Author: Paul Keahey
'Date: 2017-10-30
'Name:Comments_Excel_to_Word
'Purpose: To bring in comments From Excel to Word.
'Comments: None
Dim objWord
Dim objDoc
Dim objSelection
Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Open("C:\Test\ACBS.docx")
objWord.Visible = True
Set objSelection = objWord.Selection
Dim oRng As Word.range
Set oRng = objSelection.range
Set oScope = oRng.Duplicate
Dim oCol As New Collection
Dim FindWord As String
Dim CommentWord As String
Dim I As Integer
'initalize list of varables
For I = 2 To range("A1").End(xlDown).Row
FindWord = Sheet1.range("A" & I).Value
CommentWord = Sheet1.range("B" & I).Value
With oRng.Find
.Text = FindWord
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = True
.MatchSoundsLike = False
.MatchAllWordForms = False
Do While .Execute = True
If oRng.InRange(oScope) Then
On Error Resume Next
'MsgBox "oRng.InRange(oScope)"
oCol.Add oRng.Text, oRng.Text
On Error GoTo 0
oRng.Collapse wdCollapseEnd
Else
ActiveDocument.Comments.Add oRng, CommentWord
Exit Do
End If
Loop
End With
Next I
objDoc.Save
End Sub

Answer 1

I'm not sure I understand the Word component of this setup, but if you want to list all comments in your Excel file, you can use the script below to do that.
Sub ShowCommentsAllSheets()
'Update 20140508
Dim commrange As Range
Dim rng As Range
Dim ws As Worksheet
Dim newWs As Worksheet
Set newWs = Application.Worksheets.Add
newWs.Range("A1").Resize(1, 4).Value = Array("Sheet", "Address", "Value", "Comment")
Application.ScreenUpdating = False
On Error Resume Next
For Each ws In Application.ActiveWorkbook.Worksheets
Set commrange = ws.Cells.SpecialCells(xlCellTypeComments)
If Not commrange Is Nothing Then
i = newWs.Cells(Rows.Count, 1).End(xlUp).Row
For Each rng In commrange
i = i + 1
newWs.Cells(i, 1).Resize(1, 4).Value = Array(ws.Name, rng.Address, rng.Value, rng.Comment.Text)
Next
End If
Set commrange = Nothing
Next
newWs.Cells.WrapText = False
Application.ScreenUpdating = True
End Sub