0
votes

I need help writing a macro that searches through a large document (100+ pages) to find certain keywords, and inserts a comment at each found instance. I would like to reference hundreds of keywords, but for simplicity, I've used three keywords for this example.

Found instances of Keyword X will have a specific comment.
Found instances of Keyword Y will have a specific comment.
Found instances of Keyword Z will have a specific comment... etc.

For example:
Keyword X appears in a Word document 19 times. To complicate matters, Keyword X can be variations of the same word (e.g., work, working, worked, works)
Keyword Y appears in a Word document 7 times.
Keyword Z appears in a Word document 54 times.

For each instance of keyword X, I would like to add a comment stating "Please replace [Keyword X] with vuvuzela." (where Keyword X is the actual value that's being passed through)

For each instance of keyword Y, I would like to add a comment stating "Please add a Copyright symbol after [Keyword Y]." (where Keyword Y is the actual value that's being passed through)

For each instance of keyword Z, I would like to add a comment stating "Please add a TM symbol after [Keyword Z]."(where Keyword Z is the actual value that's being passed through)

I found some helpful code here, which allows a user to "hard code" each keyword and display a comment.

However, it is cumbersome since I have to copy and paste the entire block for each keyword, and I have hundreds. Is there a way to have one block of code to loop through searching for keywords, and have a lengthy list of "canned" responses to add in the comment bubble?

Lastly, I cannot display the keyword in the comment without putting it the comment field.

Any help this community can provide is much appreciated. Thanks in advance!

Sub CommentBubble()
Application.ScreenUpdating = False
Dim i As Long, StrCmnt As String
With ActiveDocument.range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "Keyword X"
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = Yes
    .Execute
  End With
  Do While .Find.Found
    .Comments.Add range:=.Duplicate, Text:="Please replace [keyword X] with vuvuzela."
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
Application.ScreenUpdating = True

Application.ScreenUpdating = False
With ActiveDocument.range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "Keyword Y"
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    .Execute
  End With
  Do While .Find.Found
    .Comments.Add range:=.Duplicate, Text:="Please add a Copyright symbol after [keyword Y]."
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
Application.ScreenUpdating = True

Application.ScreenUpdating = False
With ActiveDocument.range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "Keyword Z"
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    .Execute
  End With
  Do While .Find.Found
    .Comments.Add range:=.Duplicate, Text:="Please add the TM symbol after [Keyword Z]."
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
Application.ScreenUpdating = True

End Sub
1
How do you have your list of words and comments stored now?S. Melted
Same as in the example code above. However, instead of "Keyword X" it says "ensure". "Keyword 2" is something different like "MY2021"Tony
Do you not have a spreadsheet or a text file that has the list of all the words and associated comments?S. Melted
I do not currently have a spreadsheet of all the words and their variations, but I could create one.Tony
I don't have time to help now, but what I would do is make that sub take two strings as arguments, one for the keyword and one for the comment. Then call that function over and over in a loop passing each keyword comment pair to it one by one. I would probably personally want to read those values from a file, but I don't know what would be easiest or best. I'll help (much) later if you still need it.S. Melted

1 Answers

0
votes

Following on the idea of using a CSV file with two columns, first column = keywords and second column = response, I've written an example implementation, if this is a help. In the Response column, you can include a placeholder [Keyword] which will be replaced by the matched text. The column headers are optional.

Here is an example of what the CSV file can look like:

Keywords, Response
Horn, Please replace [Keyword] with vuvuzela.
Copyright, Please add a Copyright symbol after [Keyword].

If you want to use a comma in the response, you can use chr(44), e.g.

Keywords, Response
Horn, Please replace [Keyword] with vuvuzela.
Copyright, If there isn't one alreadychr(44) please add a Copyright symbol after [Keyword].

And here is the example code implementation.
Update 1: This now allows for alphanumeric keywords. If the keyword contains any numbers, MatchAllWordForms is set to False for that keyword, but otherwise is set to True. Also, if you want to match all forms of a word, make sure to write the keyword lowercase.
Update 2: Updated so that MatchAllWordForms = True only if the Keyword is composed entirely of alphabetic letters. This means the Keyword can contain other characters and won't throw an error because MatchAllWordForms will simply be set to False in that case.

Sub CommentBubble()
    Dim Rng As Range
    Dim Line() As String
    Dim FileName As String
    Dim Keyword As String
    Dim Response As String

    With Application.FileDialog(3)
        .AllowMultiSelect = False
        .ButtonName = ""
        .InitialFileName = ""
        .Title = "Pick CSV File"
        .Filters.Clear
        .Filters.Add "CSV File", "*.csv;*.txt"
        If .Show = True Then
            FileName = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With

    Application.ScreenUpdating = False

    With CreateObject("Scripting.FileSystemObject").OpenTextFile(FileName)
        Do While Not .AtEndOfStream
            Line = Split(.ReadLine, ",")
            If UBound(Line) - LBound(Line) = 1 Then
                Keyword = Trim(Line(LBound(Line)))
                Response = Trim(Line(UBound(Line)))
                If LCase(Keyword) <> "keywords" And LCase(Response) <> "response" Then
                    GoSub Find_And_Comment
                End If
            End If
        Loop
        .Close
    End With
    
    Application.ScreenUpdating = True
Exit Sub

Find_And_Comment:
    Set Rng = ActiveDocument.Content
    With Rng.Find
        .MatchAllWordForms = IIf(Keyword Like Replace(String(Len(Keyword), "*"), "*", "[a-z]"), True, False)
        Do While .Execute(FindText:=Keyword)
            Response = Replace(Response, "[Keyword]", Rng.text, , , vbTextCompare)
            Response = Replace(Response, "chr(44)", ",")
            Rng.Comments.Add Range:=Rng, text:=Response
            Rng.Collapse wdCollapseEnd
        Loop
    End With
    Return
End Sub