Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 01-20-2021, 09:56 AM
gmaxey gmaxey is offline Find code is ignoring MatchCase flag and range end being incorrectly set Windows 10 Find code is ignoring MatchCase flag and range end being incorrectly set Office 2016
Expert
 
Join Date: May 2010
Location: Brasstown, NC
Posts: 1,636
gmaxey is just really nicegmaxey is just really nicegmaxey is just really nicegmaxey is just really nicegmaxey is just really nice
Default

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.
__________________
Greg Maxey
Please visit my web site at http://www.gregmaxey.com/
Reply With Quote
  #2  
Old 01-20-2021, 09:55 PM
rekent rekent is offline Find code is ignoring MatchCase flag and range end being incorrectly set Windows 10 Find code is ignoring MatchCase flag and range end being incorrectly set Office 2016
Novice
Find code is ignoring MatchCase flag and range end being incorrectly set
 
Join Date: May 2014
Posts: 23
rekent is on a distinguished road
Default

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.
Reply With Quote
Reply



Similar Threads
Thread Thread Starter Forum Replies Last Post
Find code is ignoring MatchCase flag and range end being incorrectly set Range method Find can't find dates jmcsa3 Excel Programming 1 05-02-2020 06:56 AM
Find code is ignoring MatchCase flag and range end being incorrectly set 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

Other Forums: Access Forums

All times are GMT -7. The time now is 06:23 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2025, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2025 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft