Insert Comments from List for Whole Document and for Only Selected Portion of Document

rekent · #1 10-28-2020, 02:52 PM

I am trying to write a macro that enables me to do the following things:

1. Open an UI element and select an option.
2. Search an open document for keywords based on the selected option, where the keywords (or phrases) are located in a separate file with a carriage return between each and the keywords are highlighted in the open document.
3. Add comments from a different user name to some of the located keywords, where the comments are unique to each keyword and are located in a separate file in the format "[keyword] Statement related to keyword."
4. Identify and select a portion of the open document that includes numbers in the format "X."
5. Repeat 2 and 3 above for only the selected portion of the document identified in 4.
6. Find a single specific word in the open document, only in all upper case, and add a comment to that word (word and comment hardcoded, not found in external file).

I have steps 1 and 2 complete and functioning. I know how to change the username for step 3 and how to add comments generally through VBA, but I do not know how to add them unique to the particular keyword that was found (e.g., keyword1:comment1; keyword2:comment2; keyword3:no comment; keyword4:comment4; etc.) based on a listing in an external file.

I also am not certain about how to do steps 4 and 5. I can do step 6 in all regards other than limiting the search to only finding instances of the specific word that are in all capital letters, but I suspect that is likely something trivial to add as a style modifier to the search.

I'm not looking for someone to just write the code for me (though I also wouldn't object since I learn well from examples and working backwards). I've learned a lot already in the parts of the code that I have working and would like to try to figure this out at least semi on my own, but I realize that I am at the outer limits of my ability and am hoping for some input and direction to help me with the above points that have me stumped, especially with respect to step 4. That step has me all-around stumped, including how to set up my external file of keywords and external file of comments so that the keywords and comments for steps 2 and 3 are not used in step 4 and vice versa. I don't know if the code that I have for part 2 would be helpful, but I can post it if needed.

Guessed · #2 10-28-2020, 05:47 PM

#4, see https://www.msofficeforums.com/word-...ding-text.html

Post sample docs and/or the code you have already come up with to get focused advice.

rekent · #3 11-09-2020, 11:22 AM

Ok, below is the VBA code that I am working with. The active document that should be open and against which the macro is run is DocumentToCheck.docx and is attached. The document with preferences for use in checking the above document is PreferencesDocument.docx and is also attached.

I am still struggling with 2 aspects:

1) I identify the various keywords in the document and highlight them. Each identified and highlighted instance of "keyword1" should have a comment added that contains "Rule associated with keyword1." If there is no rule, such as for keyword2, no comment should be added for that keyword. Currently, a rule with no content is being added for keyword2 and all comments are being stacked on the very first found instance of keyword1 rather than being properly added to their respective keywords. This could go in a different module and be called if it is going to make the initial module too lengthy or difficult to easily wade through, or otherwise simplifies things.

2) In the PreferencesDocument, there is a section of keywords and rules under a heading "LIST_RULES". I need the macro to ignore that heading and not search for it. Then, in DocumentToCheck I have a numbered list under the heading "LIST". I need to search only the numbered list portion of the DocumentToCheck for the keywords and rules under the heading LIST_RULES. This means that in addition to a new search and comment routine for this section of the document, somehow the existing search will have to be set to ignore or exclude the keywords and rules appearing after LIST_RULES because I do not want to search the remainder of DocumentToCheck for those specific keywords and rules. This also could go in a different module and be called if it is going to make the initial module too lengthy or difficult to easily wade through, or otherwise simplifies things.

For 1) I have a general idea of a direction and a start because the comments are being added, they just aren't being added in the correct place. For 2) I am completely lost and am hoping for some insight from someone much more skilled than I.

Code:

Sub Highlight()

         Application.ScreenUpdating = False

          Dim strCheckDoc As String
          Dim docRef As Document
          Dim docCurrent As Document
          Dim wrdRef As String
          Dim wrdPara As Paragraph
          Dim strKeyword As String
          Dim strRule As String
          Dim cmtRuleComment As Comment

         strCheckDoc = "[path to file]\PreferencesDocument.docx"
         Set docCurrent = Selection.Document
         Set docRef = Documents.Open(strCheckDoc, ReadOnly:=True, Visible:=False)
         docCurrent.Activate
         Options.DefaultHighlightColorIndex = wdTurquoise

         With Selection.Find
            .ClearFormatting
            .Replacement.ClearFormatting
            .Replacement.Highlight = True
            .Replacement.Text = "^&"
            .Forward = True
            .Format = True
            .MatchWholeWord = True
            .MatchCase = False
            .MatchWildcards = False
        End With

        For Each wrdPara In docRef.Paragraphs
            wrdRef = wrdPara.Range.Text
            strKeyword = Split(wrdRef, ";")(0)
            strRule = Split(wrdRef, ";")(1)
            If Asc(Left(strKeyword, 1)) > 32 Then
                With Selection.Find
                    .Wrap = wdFindContinue
                    .Text = strKeyword
                    .Execute Replace:=wdReplaceAll
                    .Execute FindText:=strKeyword
                End With
                
                With Selection.Find
                    If strRule <> "" Then
                       Set cmtRuleComment = Selection.Comments.Add(Range:=Selection.Range, Text:=strRule)
                       cmtRuleComment.Author = UCase("WordCheck")
                       cmtRuleComment.Initial = UCase("WC")
                    End If
              End With

            End If
        Next wrdPara

        docRef.Close
        docCurrent.Activate
        
        Application.ScreenUpdating = True

    Exit Sub

End Sub

Guessed · #4 11-09-2020, 04:21 PM

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

rekent · #5 11-09-2020, 08:56 PM

Would it be possible to create the bookmark for DocumentToCheck dynamically within the code based on the preceding and following headings? I need to be able to run this without the document including special elements, instead just having the document's normal formatting and structure.

Could the word LIST in uppercase be found, the list ABSTRACT in uppercase be found, a range defined from immediately following the last character of LIST to immediately preceding the first character of ABSTRACT, and then add the bookmark to that range? (Not that I know how to write the code to define the range that I just suggested...)

Edit: I think this code should achieve what I describe above (searching up from the bottom of the document), but VBE is not cooperating at the moment.

Code:

Dim startPosition As Long, endPosition As Long, listRange As Range

Selection.EndKey Unit:=wdStory

With Selection.Find
        .ClearFormatting
        .Forward = Flase
        .Format = True
        .MatchWholeWord = True
        .MatchCase = True
        .MatchWildcards = False
        .Execute FindText:=uCase("ABSTRACT")

endPosition = Selection.Range.Start

With Selection.Find
        .ClearFormatting
        .Forward = False
        .Format = True
        .MatchWholeWord = True
        .MatchCase = True
        .MatchWildcards = False
        .Execute FindText:=uCase("LIST")

startPosition = Selection.Range.End

listRange.SetRange Start:=startPosition, End:=endposition
ActiveDocument.Bookmarks.Add Name:="ListArea", Range:=listRange

Guessed · #6 11-10-2020, 06:08 PM

Yes it is possible but it is always going to be slightly dodgy because we don't have exposure to your actual documents so we have to make a guess on what pattern is most robust to identify your 'List' area.

Change this line:
Set aRng = docCurrent.Bookmarks("ListArea").Range

to:
Set aRng = GetListRange(docCurrent)

and add this function to the module

Code:

Function GetListRange(aDoc As Document) As Range
  Dim aRng As Word.Range, iStart As Long, iEnd As Long
  Set aRng = aDoc.Range
  With aRng.Find
    .ClearFormatting
    .Wrap = wdFindStop
    .MatchCase = True
    .MatchWildcards = False
    .Text = "LIST"
    If .Execute Then iStart = aRng.End
    aRng.End = aDoc.Range.End
    .Text = "ABSTRACT"
    If .Execute Then iEnd = aRng.Start
    If iEnd > iStart Then
      Set GetListRange = aDoc.Range(iStart, iEnd)
    End If
  End With
End Function

rekent · #7 11-10-2020, 06:11 PM

Quote:

Originally Posted by Guessed

Yes it is possible but it is always going to be slightly dodgy because we don't have exposure to your actual documents so we have to make a guess on what pattern is most robust to identify your 'List' area.

For these particular documents I can always guarantee that the list will fall between the two enumerated headings. It is an express requirement for the documents.

Quote:

Originally Posted by Guessed

Change this line:
Set aRng = docCurrent.Bookmarks("ListArea").Range

to:
Set aRng = GetListRange(docCurrent)

and add this function to the module

This is just to make the main loop a bit cleaner and easier to follow, correct?

Guessed · #8 11-10-2020, 06:38 PM

Yes. A function allows the main Sub to appear simpler and easier to follow. Ideally Functions reduce the total amount of code required and allow for more easy re-use on different projects.

You could put that code inside the Sub if you wanted to.

rekent · #9 11-10-2020, 11:01 PM

Thank you, Andrew. Works like a charm.

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Reveal portion of document based on dropdown selection	chappeja	Word VBA	1	03-27-2019 08:36 PM
Renumber document at annex portion of document	jeffreybrown	Word	3	02-14-2019 05:53 AM
How do you add XML Schema Tags to Certain portion of a Word Document?	Anishgirijan	Word VBA	0	02-08-2017 10:38 PM
How can I link a portion of a word document to another word document and have it auto update?	__Data	Word	1	06-30-2015 11:03 PM
Save as PDF only saves portion of document	pandro	Word	0	10-08-2014 06:54 AM