Macro to insert comments on keywords in selected text in a Word doc?

Question

I'm new to VBA and would greatly appreciate some help on a problem.

I have long Word documents where I need to apply standard comments to the same set of keywords, but only in selected sections of the document. The following macro worked to find a keyword and apply a comment (from question here https://superuser.com/questions/547710/macro-to-insert-comment-bubbles-in-microsoft-word):

Sub label_items()
'
' label_items Macro
'
'
Do While Selection.Find.Execute("keyword1") = True
    ActiveDocument.Comments.Add range:=Selection.range, Text:="comment for keyword 1"
Loop

End Sub

The two modifications are:

1) only apply the comments to user selected text, not the whole document. I tried a "With Selection.Range.Find" approach but I don't think comments can be added this way (??)

2) repeat this for 20+ keywords in the selected text. The keywords aren't totally standard and have names like P_1HAI10, P_1HAI20, P_2HAI60, P_HFS10, etc.

EDIT: I have tried to combine code from similar questions ( Word VBA: finding a set of words and inserting predefined comments and Word macro, storing the current selection (VBA)) but my current attempt (below) only runs for the first keyword and comment and runs over the entire document, not just the text I have highlighted/selected.

Sub label_items()
'
' label_items Macro
'
Dim selbkup As range
Set selbkup = ActiveDocument.range(Selection.range.Start, Selection.range.End)

Set range = selbkup

Do While range.Find.Execute("keyword 1") = True
    ActiveDocument.Comments.Add range, "comment for keyword 1"
Loop

Set range = selbkup

Do While range.Find.Execute("keyword 2") = True
    ActiveDocument.Comments.Add range, "comment for keyword 2"
Loop

'I would repeat this process for all of my keywords

End Sub

I've combed through previous questions and the Office Dev Center and am stuck. Any help/guidance is greatly appreciated!

PeterT PeterT · Accepted Answer · 2016-08-16T19:32:11

It's a matter of adding a loop and a means of Finding the next keyword you're looking for. There are a few suggestions in the code example below, so please adjust it as necessary to fit your requirements.

Option Explicit

Sub label_items()
    Dim myDoc As Document
    Dim targetRange As Range
    Set myDoc = ActiveDocument
    Set targetRange = Selection.Range

    '--- drop a bookmark to return the cursor to it's original location
    Const RETURN_BM = "OrigCursorLoc"
    myDoc.Bookmarks.Add Name:=RETURN_BM, Range:=Selection.Range

    '--- if nothing is selected, then search the whole document
    If Selection.Start = Selection.End Then
        Selection.Start = 0
        targetRange.Start = 0
        targetRange.End = myDoc.Range.End
    End If

    '--- build list of keywords to search
    Dim keywords() As String
    keywords = Split("SMS,HTTP,SMTP", ",", , vbTextCompare)

    '--- search for all keywords within the user selected range
    Dim i As Long
    For i = 0 To UBound(keywords)
        '--- set the cursor back to the beginning of the
        '    originally selected range
        Selection.GoTo What:=wdGoToBookmark, Name:=RETURN_BM
        Do
            With Selection.Find
                .Forward = True
                .Wrap = wdFindStop
                .Text = keywords(i)
                .Execute

                If .Found Then
                    If (Selection.Start < targetRange.End) Then
                        Selection.Comments.Add Selection.Range, _
                                               Text:="Found the " & keywords(i) & " keyword"
                    Else
                        Exit Do
                    End If
                Else
                    Exit Do
                End If
            End With
        Loop
    Next i

    '--- set the cursor back to the beginning of the
    '    originally selected range
    Selection.GoTo What:=wdGoToBookmark, Name:=RETURN_BM

End Sub

Macro to insert comments on keywords in selected text in a Word doc?

1 Answers