I added some structure to both your docs to make the coding more forgiving. In the DocToCheck, I bookmarked the range where your list is. In the PrefsDoc I added tables to restrict the two separate loops more easily. Then the following code should do what you asked.
Code:
Sub Highlight()
Application.ScreenUpdating = False
Dim strCheckDoc As String, docRef As Document, docCurrent As Document
Dim wrdRef As String, wrdPara As Paragraph, strKeyword As String, strRule As String
Dim cmtRuleComment As Comment, tbl1 As Table, tbl2 As Table, aRow As Row, aRng As Range
Set docCurrent = ActiveDocument
strCheckDoc = docCurrent.Path & "\PreferencesDocument1.docx"
Debug.Print strCheckDoc
Set docRef = Documents.Open(strCheckDoc, ReadOnly:=True, Visible:=False)
If docRef.Tables.Count > 1 Then
Set tbl1 = docRef.Tables(1)
Set tbl2 = docRef.Tables(2)
End If
For Each aRow In tbl1.Rows
strKeyword = Split(Trim(aRow.Range.Cells(1).Range.Text), vbCr)(0)
strRule = Split(Trim(aRow.Cells(2).Range.Text), vbCr)(0)
If strKeyword <> "" Then
Set aRng = docCurrent.Range
With aRng.Find
.ClearFormatting
.Replacement.ClearFormatting
.Forward = True
.Format = True
.MatchWholeWord = True
.MatchCase = False
.MatchWildcards = False
.Text = strKeyword
Do While .Execute
aRng.HighlightColorIndex = wdTurquoise
If strRule <> "" Then
Set cmtRuleComment = docCurrent.Comments.Add(Range:=aRng, Text:=strRule)
cmtRuleComment.Author = UCase("WordCheck")
cmtRuleComment.Initial = UCase("WC")
End If
Loop
End With
End If
Next aRow
For Each aRow In tbl2.Rows
strKeyword = Split(Trim(aRow.Range.Cells(1).Range.Text), vbCr)(0)
strRule = Split(Trim(aRow.Cells(2).Range.Text), vbCr)(0)
If strKeyword <> "" Then
Set aRng = docCurrent.Bookmarks("ListArea").Range
With aRng.Find
.ClearFormatting
.Replacement.ClearFormatting
.Forward = True
.Format = True
.MatchWholeWord = True
.MatchCase = False
.MatchWildcards = False
.Text = strKeyword
Do While .Execute
aRng.HighlightColorIndex = wdYellow
If strRule <> "" Then
Set cmtRuleComment = docCurrent.Comments.Add(Range:=aRng, Text:=strRule)
cmtRuleComment.Author = UCase("WordCheck")
cmtRuleComment.Initial = UCase("WC")
End If
Loop
End With
End If
Next aRow
docRef.Close
docCurrent.Activate
Application.ScreenUpdating = True
Exit Sub
End Sub