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

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