Find code is ignoring MatchCase flag and range end being incorrectly set

rekent · #1 01-19-2021, 09:33 AM

The below code is supposed to search the attached WorkingDoc.docx based on the attached strCheckDoc.docx. Words in the left column of strCheckDoc are found and highlighted, and contents of the right column for a given row are added as a comment to the highlighted word. The search is supposed to be performed in a range that is defined according to the headers that bound respective sections of WorkingDoc.

There are currently two issues that I haven't been able to track down resolutions for:

1) MatchCase = False is set, but the search is still acting case sensitive. For example, fullapplicationword is not being found based on the search for Fullapplicationword.

2) The GetDocRange function does not appear to be correctly setting the end of aRng. For example, backgroundword is found in all sections beginning with and following the BACKGROUND section instead of just in the range between "BACKGROUND" and "SUMMARY," summaryword is found in all sections beginning with and following the SUMMARY section instead of just in the range between "SUMMARY" and "DRAWINGS," etc.

Does anyone see what I could be missing to result in the above errors?

Code:

Sub Highlight(ByRef strUser As String)
   
  Dim strCheckDoc As String, docRef As Document, docCurrent As Document, trkChg As Boolean
  Dim wrdRef As String, wrdPara As Paragraph, strKeyword As String, strRule As String
  Dim cmtRuleComment As Comment, tbl1 As Table, tbl2 As Table, tbl3 As Table, tbl4 As Table, _
    tbl5 As Table, tbl6 As Table, tbl7 As Table, aRow As Row, aRng As Range
  
  Set docCurrent = ActiveDocument
  strCheckDoc = [path to strCheckDoc document]
  Debug.Print strCheckDoc
  Set docRef = Documents.Open(strCheckDoc, ReadOnly:=True, Visible:=False)
  If docRef.Tables.Count > 1 Then
    Set tbl1 = docRef.Tables(1) 'Full Application Rules
    Set tbl2 = docRef.Tables(2) 'Background Specific Rules
    Set tbl3 = docRef.Tables(3) 'Summary Specific Rules
    Set tbl4 = docRef.Tables(4) 'Brief Description of the Drawings Specific Rules
    Set tbl5 = docRef.Tables(5) 'Detailed Description Specific Rules
    Set tbl6 = docRef.Tables(6) 'Claim Specific Rules
    Set tbl7 = docRef.Tables(7) 'Abstract Specific Rules
  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 = True
        .Text = strKeyword
        Do While .Execute
          aRng.HighlightColorIndex = wdTurquoise
          If strRule <> "" Then
            Set cmtRuleComment = docCurrent.Comments.Add(Range:=aRng, Text:=strUser & ": " & 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 = GetDocRange(docCurrent, "BACKGROUND", "SUMMARY")
      With aRng.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Forward = True
        .Format = True
        .MatchWholeWord = True
        .MatchCase = False
        .MatchWildcards = True
        .Text = strKeyword
        Do While .Execute
          aRng.HighlightColorIndex = wdTurquoise
          If strRule <> "" Then
            Set cmtRuleComment = docCurrent.Comments.Add(Range:=aRng, Text:=strUser & ": " & strRule)
            cmtRuleComment.Author = UCase("WordCheck")
            cmtRuleComment.Initial = UCase("WC")
          End If
        Loop
      End With
    End If
  Next aRow
  
  For Each aRow In tbl3.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 = GetDocRange(docCurrent, "SUMMARY", "DRAWINGS")
      With aRng.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Forward = True
        .Format = True
        .MatchWholeWord = True
        .MatchCase = False
        .MatchWildcards = True
        .Text = strKeyword
        Do While .Execute
          aRng.HighlightColorIndex = wdTurquoise
          If strRule <> "" Then
            Set cmtRuleComment = docCurrent.Comments.Add(Range:=aRng, Text:=strUser & ": " & strRule)
            cmtRuleComment.Author = UCase("WordCheck")
            cmtRuleComment.Initial = UCase("WC")
          End If
        Loop
      End With
    End If
  Next aRow
  
  For Each aRow In tbl4.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 = GetDocRange(docCurrent, "DRAWINGS", "DETAILED")
      With aRng.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Forward = True
        .Format = True
        .MatchWholeWord = True
        .MatchCase = False
        .MatchWildcards = True
        .Text = strKeyword
        Do While .Execute
          aRng.HighlightColorIndex = wdTurquoise
          If strRule <> "" Then
            Set cmtRuleComment = docCurrent.Comments.Add(Range:=aRng, Text:=strUser & ": " & strRule)
            cmtRuleComment.Author = UCase("WordCheck")
            cmtRuleComment.Initial = UCase("WC")
          End If
        Loop
      End With
    End If
  Next aRow
  
  For Each aRow In tbl5.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 = GetDocRange(docCurrent, "DETAILED", "CLAIMS")
      With aRng.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Forward = True
        .Format = True
        .MatchWholeWord = True
        .MatchCase = False
        .MatchWildcards = True
        .Text = strKeyword
        Do While .Execute
          aRng.HighlightColorIndex = wdTurquoise
          If strRule <> "" Then
            Set cmtRuleComment = docCurrent.Comments.Add(Range:=aRng, Text:=strUser & ": " & strRule)
            cmtRuleComment.Author = UCase("WordCheck")
            cmtRuleComment.Initial = UCase("WC")
          End If
        Loop
      End With
    End If
  Next aRow
  
  For Each aRow In tbl6.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 = GetDocRange(docCurrent, "CLAIMS", "ABSTRACT")
      With aRng.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Forward = True
        .Format = True
        .MatchWholeWord = True
        .MatchCase = False
        .MatchWildcards = True
        .Text = strKeyword
        Do While .Execute
          aRng.HighlightColorIndex = wdTurquoise
          If strRule <> "" Then
            Set cmtRuleComment = docCurrent.Comments.Add(Range:=aRng, Text:=strUser & ": " & strRule)
            cmtRuleComment.Author = UCase("WordCheck")
            cmtRuleComment.Initial = UCase("WC")
          End If
        Loop
      End With
    End If
  Next aRow
  
  For Each aRow In tbl7.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 = GetDocRange(docCurrent, "ABSTRACT", "ABSTRACT")
      With aRng.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Forward = True
        .Format = True
        .MatchWholeWord = True
        .MatchCase = False
        .MatchWildcards = True
        .Text = strKeyword
        Do While .Execute
          aRng.HighlightColorIndex = wdTurquoise
          If strRule <> "" Then
            Set cmtRuleComment = docCurrent.Comments.Add(Range:=aRng, Text:=strUser & ": " & strRule)
            cmtRuleComment.Author = UCase("WordCheck")
            cmtRuleComment.Initial = UCase("WC")
          End If
        Loop
      End With
    End If
  Next aRow
  
  docRef.Close
  docCurrent.Activate
           
End Sub

Function GetDocRange(aDoc As Document, startWord As String, endWord As String) 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 = startWord
    If .Execute Then iStart = aRng.End
    aRng.End = aDoc.Range.End
    .Text = endWord
    If .Execute Then iEnd = aRng.Start
    If startWord = "ABSTRACT" Then iEnd = aDoc.Range.End
    If iEnd > iStart Then
      Set GetDocRange = aDoc.Range(iStart, iEnd)
    End If
  End With
End Function

gmaxey · #2 01-19-2021, 10:23 AM

This should work.

Code:

Sub Test()
  Highlight "Gregory K. Maxey"
End Sub
Sub Highlight(ByRef strUser As String)
   
  Dim strCheckDoc As String, docRef As Document, docCurrent As Document, trkChg As Boolean
  Dim wrdRef As String, wrdPara As Paragraph, strKeyword As String, strRule As String
  Dim cmtRuleComment As Comment, tbl1 As Table, tbl2 As Table, tbl3 As Table, tbl4 As Table, _
    tbl5 As Table, tbl6 As Table, tbl7 As Table, aRow As Row, aRng As Range
  
  '***
  Dim oRngScope As Range
  
  Set docCurrent = ActiveDocument
  strCheckDoc = "D:\strCheckDoc.docx"
  Debug.Print strCheckDoc
  Set docRef = Documents.Open(strCheckDoc, ReadOnly:=True, Visible:=False)
  If docRef.Tables.Count > 1 Then
    Set tbl1 = docRef.Tables(1) 'Full Application Rules
    Set tbl2 = docRef.Tables(2) 'Background Specific Rules
    Set tbl3 = docRef.Tables(3) 'Summary Specific Rules
    Set tbl4 = docRef.Tables(4) 'Brief Description of the Drawings Specific Rules
    Set tbl5 = docRef.Tables(5) 'Detailed Description Specific Rules
    Set tbl6 = docRef.Tables(6) 'Claim Specific Rules
    Set tbl7 = docRef.Tables(7) 'Abstract Specific Rules
  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 '*** True negates MatchCase
        .Text = strKeyword
        Do While .Execute
          aRng.HighlightColorIndex = wdTurquoise
          If strRule <> "" Then
            Set cmtRuleComment = docCurrent.Comments.Add(Range:=aRng, Text:=strUser & ": " & 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 = GetDocRange(docCurrent, "BACKGROUND", "SUMMARY")
      Set oRngScope = aRng.Duplicate '*** Define the scope
      With aRng.Find
        .Text = strKeyword
        Do While .Execute
          If Not aRng.InRange(oRngScope) Then Exit For '*** You were falling victim of Find's runaway range.
          aRng.HighlightColorIndex = wdTurquoise
          If strRule <> "" Then
            Set cmtRuleComment = docCurrent.Comments.Add(Range:=aRng, Text:=strUser & ": " & strRule)
            cmtRuleComment.Author = UCase("WordCheck")
            cmtRuleComment.Initial = UCase("WC")
          End If
        Loop
      End With
    End If
  Next aRow
  
  For Each aRow In tbl3.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 = GetDocRange(docCurrent, "SUMMARY", "DRAWINGS")
      Set oRngScope = aRng.Duplicate
      With aRng.Find
        .Text = strKeyword
        Do While .Execute
          If Not aRng.InRange(oRngScope) Then Exit For
          aRng.HighlightColorIndex = wdTurquoise
          If strRule <> "" Then
            Set cmtRuleComment = docCurrent.Comments.Add(Range:=aRng, Text:=strUser & ": " & strRule)
            cmtRuleComment.Author = UCase("WordCheck")
            cmtRuleComment.Initial = UCase("WC")
          End If
        Loop
      End With
    End If
  Next aRow
  
  For Each aRow In tbl4.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 = GetDocRange(docCurrent, "DRAWINGS", "DETAILED")
      Set oRngScope = aRng.Duplicate
      With aRng.Find
        .Text = strKeyword
        Do While .Execute
          If Not aRng.InRange(oRngScope) Then Exit For
          aRng.HighlightColorIndex = wdTurquoise
          If strRule <> "" Then
            Set cmtRuleComment = docCurrent.Comments.Add(Range:=aRng, Text:=strUser & ": " & strRule)
            cmtRuleComment.Author = UCase("WordCheck")
            cmtRuleComment.Initial = UCase("WC")
          End If
        Loop
      End With
    End If
  Next aRow
  
  For Each aRow In tbl5.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 = GetDocRange(docCurrent, "DETAILED", "CLAIMS")
      Set oRngScope = aRng.Duplicate
      With aRng.Find
        .Text = strKeyword
        Do While .Execute
          If Not aRng.InRange(oRngScope) Then Exit For
          aRng.HighlightColorIndex = wdTurquoise
          If strRule <> "" Then
            Set cmtRuleComment = docCurrent.Comments.Add(Range:=aRng, Text:=strUser & ": " & strRule)
            cmtRuleComment.Author = UCase("WordCheck")
            cmtRuleComment.Initial = UCase("WC")
          End If
        Loop
      End With
    End If
  Next aRow
  
  For Each aRow In tbl6.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 = GetDocRange(docCurrent, "CLAIMS", "ABSTRACT")
      Set oRngScope = aRng.Duplicate
      With aRng.Find
        .Text = strKeyword
        Do While .Execute
          If Not aRng.InRange(oRngScope) Then Exit For
          aRng.HighlightColorIndex = wdTurquoise
          If strRule <> "" Then
            Set cmtRuleComment = docCurrent.Comments.Add(Range:=aRng, Text:=strUser & ": " & strRule)
            cmtRuleComment.Author = UCase("WordCheck")
            cmtRuleComment.Initial = UCase("WC")
          End If
        Loop
      End With
    End If
  Next aRow
  
  For Each aRow In tbl7.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 = GetDocRange(docCurrent, "ABSTRACT", "ABSTRACT")
      Set oRngScope = aRng.Duplicate
      With aRng.Find
        .ClearFormatting
        .Text = strKeyword
        Do While .Execute
          If Not aRng.InRange(oRngScope) Then Exit For
          aRng.HighlightColorIndex = wdTurquoise
          If strRule <> "" Then
            Set cmtRuleComment = docCurrent.Comments.Add(Range:=aRng, Text:=strUser & ": " & strRule)
            cmtRuleComment.Author = UCase("WordCheck")
            cmtRuleComment.Initial = UCase("WC")
          End If
        Loop
      End With
    End If
  Next aRow
  
  docRef.Close
  docCurrent.Activate
           
End Sub

Function GetDocRange(aDoc As Document, startWord As String, endWord As String) 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 = startWord
    If .Execute Then iStart = aRng.End
    aRng.End = aDoc.Range.End
    .Text = endWord
    If .Execute Then iEnd = aRng.Start
    If startWord = "ABSTRACT" Then iEnd = aDoc.Range.End
    If iEnd > iStart Then
      Set GetDocRange = aDoc.Range(iStart, iEnd)
    End If
  End With
End Function

rekent · #3 01-19-2021, 11:54 AM

Darn runaway range. That solved it, thanks!

Now on to figuring out how to make the sections that are searched user-selectable via a userform and condense those 6 virtually identical For loops into a single callable function.

gmaxey · #4 01-19-2021, 02:09 PM

For a common process, you could make the docCurrent a module level variable and then pass arguments to:

Code:

Sub ProcessTable(oTbl As Table, strStartWord As String, strEndWord As String, strUser As String)
Dim oRng As Row
Dim strKeyword As String, strRule As String
  For Each oRow In oTbl.Rows
    strKeyword = Split(Trim(oRow.Range.Cells(1).Range.Text), vbCr)(0)
    strRule = Split(Trim(oRow.Cells(2).Range.Text), vbCr)(0)
    If strKeyword <> "" Then
      Set oRng = GetDocRange("DETAILED", "CLAIMS") 'make docCurrent a module level varialbe
      Set oRngScope = oRng.Duplicate
      With oRng.Find
        .Text = strKeyword
        Do While .Execute
          If Not oRng.InRange(oRngScope) Then Exit For
          oRng.HighlightColorIndex = wdTurquoise
          If strRule <> "" Then
            Set cmtRuleComment = m_oDocCurrent.Comments.Add(Range:=oRng, Text:=strUser & ": " & strRule)
            cmtRuleComment.Author = UCase("WordCheck")
            cmtRuleComment.Initial = UCase("WC")
          End If
        Loop
      End With
    End If
  Next oRow
End Sub
Function GetDocRange(startWord As String, endWord As String) As Range
Dim oRng As Word.Range, iStart As Long, iEnd As Long
  Set oRng = m_oDocCurrent.Range
  With oRng.Find
    .Text = startWord
    If .Execute Then iStart = oRng.End
    oRng.End = aDoc.Range.End
    .Text = endWord
    If .Execute Then iEnd = oRng.Start
    If startWord = "ABSTRACT" Then iEnd = aDoc.Range.End
    If iEnd > iStart Then
      Set GetDocRange = aDoc.Range(iStart, iEnd)
    End If
  End With
End Function

rekent · #5 01-19-2021, 11:32 PM

Ok, I may be in over my head. Here is the concept of what I am attempting, but failing, to do.

I have a UserForm that has 6 toggle buttons and a command button. Each toggle button corresponds to one of the possible sections in the document, which are the words passed to GetDocRange as startWord and endWord. The idea is to click the toggle buttons for the sections that are in a given document and then click the command button to close the UserForm and continue with execution of the macro.

Based on which toggle buttons are set to true, corresponding variables should be set to true. Based on the values of those variables, startWord and endWord should be provided. For example, the possible sections as represented by the toggle buttons are Background, Summary, Drawing, Description, Claim, and Abstract.

If all sections are present, the code should progress through a first loop with startWord = Background and endWord = Summary, a second loop with startWord = Summary and endWord = Drawing, etc. When startWord is Abstract, endWord should also be Abstract.

However, if all sections are not present, that section should be skipped. For example, assume that Summary is not present in some given document. In that case, the toggle buttons for all sections other than Summary are toggled true and the code should progress through a first loop with startWord = Background and endWord = Drawing, a second loop with startWord = Drawing and endWord = Description, etc. When startWord is Abstract, endWord should again be Abstract.

I have ToggleButtonX_Change routines for each toggle button in the UserForm that chack whether the button value is true or false, but I'm having trouble figuring out where to stick the variables (and what type they should be) for the loop, as well as figuring out how to set up the loop to do the skips as I described. My thought is some sort of For loop with the index used for the table number as well as selecting which of the section names to use for startWord and endWord, but that's a half-baked thought that I can't seem to round out into an outline for coding. The second thought was combining the For loop and index with a select case statement to evaluate the various possible outcomes, but that thought didn't get much farther than the first. I'm open to any suggestions or advice, and thanks in advance.

rekent · #6 01-20-2021, 12:03 AM

I've also run into an interesting new issue where docRef.Tables.Count is returning a value of 2 when in fact there are 7 tables in docRef.

gmaxey · #7 01-20-2021, 09:56 AM

You might have to tinker with this a little but I don't see why you would need a userform. I'm assuming the reference document will always have the seven tables:

Code:

Option Explicit
Private m_oDocCurrent As Document
Sub Test()
  Highlight "Gregory K. Maxey"
End Sub
Sub Highlight(ByRef strUser As String)
Dim strCheckDoc As String, docRef As Document
Dim lngIndex As Long
  Set m_oDocCurrent = ActiveDocument
  strCheckDoc = "D:\strCheckDoc.docx"
  Set docRef = Documents.Open(strCheckDoc, ReadOnly:=True, Visible:=False)
  For lngIndex = 1 To docRef.Tables.Count
    Select Case lngIndex
      Case 1: ProcessTable docRef.Tables(1), strUser
      Case 2: ProcessTable docRef.Tables(2), strUser, "BACKGROUND", "SUMMARY|DRAWINGS|DETAILED|CLAIMS|ABSTRACT"
      Case 3: ProcessTable docRef.Tables(3), strUser, "SUMMARY", "DRAWINGS|DETAILED|CLAIMS|ABSTRACT"
      Case 4: ProcessTable docRef.Tables(4), strUser, "DRAWINGS", "DETAILED|CLAIMS|ABSTRACT"
      Case 5: ProcessTable docRef.Tables(5), strUser, "DETAILED", "CLAIMS|ABSTRACT"
      Case 6: ProcessTable docRef.Tables(6), strUser, "CLAIMS", "ABSTRACT"
      Case 7: ProcessTable docRef.Tables(7), strUser, "ABSTRACT", "ABSTRACT"
    End Select
  Next lngIndex
  docRef.Close
  m_oDocCurrent.Activate
lbl_Exit:
  Exit Sub
End Sub

Sub ProcessTable(oTbl As Table, strUser As String, _
                 Optional strStartWord As String = vbNullString, Optional strEndWord As String = vbNullString)

Dim oRng As Range, oRngScope As Range
Dim oRow As Row
Dim strKeyword As String, strRule As String
Dim oComment As Comment
Dim arrEndWords() As String
Dim lngIndex As Long
  For Each oRow In oTbl.Rows
    strKeyword = Split(Trim(oRow.Range.Cells(1).Range.Text), vbCr)(0)
    strRule = Split(Trim(oRow.Cells(2).Range.Text), vbCr)(0)
    If strKeyword <> "" Then
      If Not strStartWord = vbNullString Then
        'Process defined sections
        arrEndWords = Split(strEndWord, "|")
        For lngIndex = 0 To UBound(arrEndWords)
          Set oRng = GetDocRange(strStartWord, arrEndWords(lngIndex))
          If Not oRng Is Nothing Then Exit For
        Next lngIndex
      Else
        'Process whole document
        Set oRng = m_oDocCurrent.Range
      End If
      If Not oRng Is Nothing Then
        Set oRngScope = oRng.Duplicate
        With oRng.Find
          .Text = strKeyword
          Do While .Execute
            If Not oRng.InRange(oRngScope) Then Exit For
            oRng.HighlightColorIndex = wdTurquoise
            If strRule <> "" Then
              Set oComment = m_oDocCurrent.Comments.Add(Range:=oRng, Text:=strUser & ": " & strRule)
              oComment.Author = UCase("WordCheck")
              oComment.Initial = UCase("WC")
            End If
          Loop
        End With
      End If
    End If
  Next oRow
End Sub
Function GetDocRange(startWord As String, endWord As String) As Range
Dim oRng As Word.Range, lngStart As Long, lngEnd As Long
  Set oRng = m_oDocCurrent.Range
  With oRng.Find
    .Text = startWord
    If .Execute Then lngStart = oRng.End
    oRng.End = m_oDocCurrent.Range.End
    .Text = endWord
    If .Execute Then lngEnd = oRng.Start
    If startWord = "ABSTRACT" Then lngEnd = m_oDocCurrent.Range.End
    If lngEnd > lngStart Then
      Set GetDocRange = m_oDocCurrent.Range(lngStart, lngEnd)
    End If
  End With
End Function

You have had your hand out quite far here ;-). People do this sort of thing for a living so don't always expect your solutions to be handed to you.

rekent · #8 01-20-2021, 09:55 PM

Greg,

Thank you very much for your assistance, it is greatly appreciated.

I would like to respectfully mention one thing though. I am most assuredly grateful for the code sections that you provided, but I take slight issue with the "had your hand out quite far here" portion. I am well aware that people do this for a living, and my small project is to make my personal life a bit easier and as a learning experience. If you'll please note, I asked if anyone saw the error that I was making, and then later asked for suggestions or advice. I never asked for code to be written for me and have had my nose in the VBA developer notes over on Microsoft's website and other resources to learn and understand the the coding, but I recognize that "textbooks" are no replacement for practical experience, which is why I came here for guidance to be pointed in the right direction based on other's experience for further research and learning.

Again, I truly appreciate your assistance and your taking the time to provide functioning code. It works almost perfectly and the one use case for which it isn't quite functioning properly when a section is missing from the reference document is something that I will work through and debug.

gmaxey · #9 01-21-2021, 11:05 AM

rekent,

Fair enough. Chalk it up as a bad day. I apologize.

With your test documents provided, I removed the section "SUMMARY" and the code seemed to work as expected. That was the extent of the testing so not surprised you have found some issues. If you need more help, post back.

rekent · #10 01-21-2021, 01:37 PM

Tracked it down. GetDocRange was returning an incorrect value for oRng because when the SUMMARY section was missing, "SUMMARY" was not found and lngStart remained at zero. But the next section header "DRAWINGS" was found, creating a range from document start to the beginning of "DRAWINGS." The nested If statements at the end of this function seem to do the trick, and I haven't been able to come up with a scenario yet in which they break other functionality.

Code:

Function GetDocRange(startWord As String, endWord As String) As Range
Dim oRng As Word.Range, lngStart As Long, lngEnd As Long
  Set oRng = m_oDocCurrent.Range
  With oRng.Find
    .Wrap = wdFindStop
    .MatchCase = True
    .Text = startWord
    If .Execute Then lngStart = oRng.End
    oRng.End = m_oDocCurrent.Range.End
    .Text = endWord
    If .Execute Then lngEnd = oRng.Start
    If startWord = "ABSTRACT" Then lngEnd = m_oDocCurrent.Range.End
    If lngStart = "0" Then
      Set GetDocRange = m_oDocCurrent.Range(lngStart, lngStart)
    Else
      If lngEnd > lngStart Then
        Set GetDocRange = m_oDocCurrent.Range(lngStart, lngEnd)
      End If
    End If
  End With
End Function

gmaxey · #11 01-21-2021, 01:43 PM

rekent,

lngStart is a long variable and you are checking it against a string "0"

Does it still work if your make that: If lngStart = 0

rekent · #12 01-21-2021, 01:57 PM

Interestingly, it seems to work both ways.

gmaxey · #13 01-21-2021, 02:04 PM

Not really, the compiler will resolve strings to long:

Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
MsgBox "4" * "5"
lbl_Exit:
Exit Sub
End Sub

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Range method Find can't find dates	jmcsa3	Excel Programming	1	05-02-2020 06:56 AM
Find if Date range falls within another range	Triadragon	Excel	3	05-02-2016 11:48 AM
Find a Date in a Range	rspiet	Excel	3	02-15-2016 08:37 AM
find IP in range / find number between numbers	gn28	Excel	4	06-14-2015 03:46 PM
Find and Replace within range	anil3b2	Word VBA	3	12-01-2010 02:35 AM