Word VBA - Find doesn't work if Table present immediately below

I'm making this 2nd post of an earlier question, as I have more information and a better sample to attach.

In the sample Word doc I have Heading 1, 2 and 3. The code in Module1 will find each Heading  in sequence. This works for Heading 1 and 2, but not Heading 3.
I found that the reason is the existence of the table within the text below the Heading 3.

New information
It turns out that the problem occurs ONLY when the table is directly below the Heading.

I have attached a sample doc.HM-sample-for-EE2.docm
To see what I mean:
Run the code in Module1 by stepping through (F8).
See that it finds the first Heading 3. On the next time round the loop the code should select the next Heading 3. But instead it finds the same one.
This is because there is a table immediately below the Heading.
To test this, enter a line of text below the Heading. This time it will work.
To test further, change the find criterion to 'Heading 1' or 'Heading 2'. It will work.

QUESTION:
What is it that the doc has got that prevents Find from working as it should?

(Note: Martin, thanks for your valuable advice on coding. I shall apply them in future, although I haven't modified this sample)
hindersalivaAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Martin LissOlder than dirtCommented:
Sub FillArrayAll()
    Dim rngContent As Range
    Dim docThis As Document
    Dim intPara As Integer
    Dim dteStart As Date
    Dim strHeadingToFind As String
    Dim strLastItemID As String
    Dim i As Integer
    Dim dteEnd As Date
    Dim intItemsAll As Integer
    
    'Find Headings code reduced in order to troubleshoot the 'Heading 3 issue'. 14/02/2018
    'Description of Issue:
    'Find is finding Heading 2 and 2 correctly, but not Heading 3
    
    dteStart = Now
    
    Application.ScreenUpdating = False
    
    
    ReDim arrItemsAll(1 To 6, 1 To 2000)
    
    Set docThis = ActiveDocument

    Set rngContent = docThis.Bookmarks("TheContent").Range     'This is to make the Find start from the top
    
    strHeadingToFind = "Heading 3"  '<<<<<<<<<<<<<< EDIT THIS TO test with Heading 2 and 3
    
    'find last item
    With rngContent.Find
    .ClearFormatting
    .Style = strHeadingToFind
    .Execute Forward:=False
    End With
    
    Set rngContent = docThis.Content
    
    i = 1
    
    ActiveDocument.ActiveWindow.View.ShowHiddenText = True
    
    With rngContent.Find
        .ClearFormatting
        .Style = strHeadingToFind
        .Execute Forward:=True

        For intPara = 1 To docThis.Paragraphs.Count
        ' The Left method is needed because your Heading 3 style says more that just "Heading 3"
            If Left$(docThis.Paragraphs(intPara).Style, 9) = strHeadingToFind Then
                If docThis.Paragraphs(intPara).Range.Tables.Count = 0 Then
                    docThis.Paragraphs(intPara).Range.Words(1).Select
                    
                    arrItemsAll(1, i) = docThis.Paragraphs(intPara).Range.Words(1).Text
                    arrItemsAll(2, i) = Right(docThis.Paragraphs(intPara).Range.Text, Len(docThis.Paragraphs(intPara).Range.Text) - 8)
                    arrItemsAll(3, i) = i
                    arrItemsAll(4, i) = docThis.Paragraphs(intPara).Range.Start
                
                    If docThis.Paragraphs(intPara).Range.Font.Hidden Then
                        arrItemsAll(5, i) = "False"
                    End If
                    If Not docThis.Paragraphs(intPara).Range.Font.Hidden Then
                        arrItemsAll(5, i) = "True"
                    End If
                    arrItemsAll(6, i) = ""
                    
                    i = i + 1
                    MsgBox "Processed " & Trim(docThis.Paragraphs(intPara).Range.Words(1).Text)
                    If Trim(docThis.Paragraphs(intPara).Range.Words(1).Text) = strLastItemID Then
                        Exit For 'Do
                    End If
        
                    strLastItemID = Trim(docThis.Paragraphs(intPara).Range.Words(1).Text)
                End If
            End If
        Next
    End With

    ActiveDocument.ActiveWindow.View.ShowHiddenText = False
    
    'add an END item to the array
    arrItemsAll(1, i) = "End"
    arrItemsAll(2, i) = "End"
    arrItemsAll(3, i) = i
    arrItemsAll(4, i) = ActiveDocument.Bookmarks("TheContent").End
    arrItemsAll(5, i) = ""
    arrItemsAll(6, i) = "End SubClauses"
    
    dteEnd = Now
    
    intItemsAll = i
    
    ReDim Preserve arrItemsAll(1 To 6, 1 To intItemsAll)
    
    MsgBox intItemsAll & vbCr & dteStart & vbCr & dteEnd
End Sub

Open in new window

0
hindersalivaAuthor Commented:
Martin, it works! Thanks.
For academic reasons: But I don't understand why. You said in the comments, Heading 3 has more than Heading 3 in the name. But so has Headings 1 and 2.
AND the the code works without the Left(...., 9) when the table is not immediately below.

EDIT:
Ah sorry. I see that you're looping through the paragraphs, rather than using Find. Looping the paragraphs in this case is impractical - there are 10,000s of them! Therefore I used Find, which is quick enough.

So, I'm still looking for an answer to ... how can I use a Find to Find when 'a table is directly below/next to the thing I'm trying to find?

There must be some hidden text or something lurking between the Heading and the Table. But what? OR something about the style that's applied to the table?
0
Martin LissOlder than dirtCommented:
You'll need to fill in the "details" of course.
Sub ThisWorks()
Dim bFound As Boolean
Dim strFirst As String

Do
    Selection.Find.ClearFormatting
    Selection.Find.Style = ActiveDocument.Styles("Heading 3,Sub-clause Heading,1R Contents Heading 3,VS3")
    With Selection.Find
        .Text = "M"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = True
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    bFound = Selection.Find.Execute
    If bFound Then
        If strFirst = "" Then
            strFirst = Selection.Words(1)
        ElseIf strFirst = Selection.Words(1) Then
            Exit Do
        End If
        MsgBox Selection.Words(1)
    End If
    Loop
End Sub

Open in new window

0
Become a Certified Penetration Testing Engineer

This CPTE Certified Penetration Testing Engineer course covers everything you need to know about becoming a Certified Penetration Testing Engineer. Career Path: Professional roles include Ethical Hackers, Security Consultants, System Administrators, and Chief Security Officers.

hindersalivaAuthor Commented:
Martin, this looks promising. It works.

Now to test if it's quick enough, I need to make it 'not select'. How can I change it?
I have the entire range in a bookmark called "TheContent".

(tried hacking it, but failed)
0
Martin LissOlder than dirtCommented:
If you add Application.ScreenUpdating = False do you really care about selecting (since it won't be taking any time updating the screen)?
0
hindersalivaAuthor Commented:
Ah. Good point. I hadn't thought of that. I thought 'selecting' cells in Excel slowed things down instead of addressing a Range?
0
Martin LissOlder than dirtCommented:
It's the screen updating that takes the time but the risk is that the user will manually select something while the code is running. I've tried to do it using Range but I can't figure it out since I'm not really a Word VBA programmer.

Have you run the actual document with the selection code? If so how long did it take?
0
hindersalivaAuthor Commented:
Martin, with ScreenUpdating = False it took 18 seconds in a document that had 450 items to find. The whole document will take (I estimate) approx 40 seconds. That's with the code just only finding the items, not doing anything with it.

In contrast, the Find I have (when 'fixed' by inserting some text between the Heading and the Tables) takes 11 seconds to loop over the entire document, find Headings 1 to 3, and insert the relevant data (text, character position, show/hide state) into an array.

That's why I need to find an answer to why the tables that are immediately below the Heading are causing the Find to get stuck. ie. does not Find the next item, but finds itself and so goes round in a loop.
0
Martin LissOlder than dirtCommented:
I don't think it can be faster than this.

Sub ThisWorksRange()
Dim strFirst As String
Dim rng As Range

Set rng = ActiveDocument.Content

Do
    With rng.Find
            .Text = "<M0*>"
            .Forward = True
            .Wrap = wdFindContinue
            .Format = True
            .MatchCase = True
            .MatchWholeWord = False
            .MatchWildcards = True
            .MatchSoundsLike = False
            .MatchAllWordForms = False
            .Style = ActiveDocument.Styles("Heading 3,Sub-clause Heading,1R Contents Heading 3,VS3")
            .ClearFormatting
            .Execute
            If strFirst = "" Then
                strFirst = rng.Words(1)
            ElseIf strFirst = rng.Words(1) Then
                Exit Do
            End If
            MsgBox rng.Words(1)
        End With
Loop

End Sub

Open in new window

0
Martin LissOlder than dirtCommented:
I take that back:)

Sub ThisWorks()
Dim rng As Range

Set rng = ActiveDocument.Content

With rng.Find
    ' Look for a string of any length starting with "M"
    ' and followed by  0 to 9
    .Text = "<M[0-9]*>"
    .Forward = True
    .Wrap = wdFindStop 'Continue
    .Format = True
    .MatchCase = True
    .MatchWholeWord = False
    .MatchWildcards = True
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    .ClearFormatting
    Do While .Execute
        If rng.Style = ActiveDocument.Styles("Heading 3") Then
            Debug.Print rng.Words(1)
        End If
        rng.Collapse Direction:=wdCollapseEnd
    Loop
End With

End Sub

Open in new window


Result:
M030701
M030704
M030707
0
hindersalivaAuthor Commented:
Martin, it is faster than earlier - takes 20 seconds, looking for Heading 1, 2 or 3.

I have learned from you the principle of narrowing down the find-criterion to "M" followed by 0-9, and the syntax for it. I never knew that was possible.
But, of course, narrowing down the find-criterion slows down the procedure.

Thank you.
0
Martin LissOlder than dirtCommented:
I needed to do that because the code in the Find itself actually ignores the style. It's a mystery to me why that happens but I'll take another look.
0
hindersalivaAuthor Commented:
In my quest to find out why 'Find' isn't working as it should (ie. where a table occurs immediately below, 'find' finds itself again) I found this
https://gregmaxey.com/word_tip_pages/words_fickle_vba_find_property.html

So, is my problem because of these bugs in Word, or something about the tables in this document? IOW, is it a workaround I need, or ask my client to fix his Word documents?

(I'm still thinking there's something lurking between the Heading and the Table that none of us has been able to pinpoint)
0
Martin LissOlder than dirtCommented:
If you eliminate the .Text parameter then the .Style work!

Sub ThisWorks()
Dim rng As Range

Set rng = ActiveDocument.Content

With rng.Find
    ' Look for a string of any length starting with "M"
    ' and followed by  0 to 9
    '.Text = "<M[0-9]*>"
    .Forward = True
    .Wrap = wdFindStop
    .Format = True
    .MatchCase = True
    .MatchWholeWord = False
    .MatchWildcards = True
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    .ClearFormatting
    .Style = ActiveDocument.Styles("Heading 3")
    Do While .Execute
        'If rng.Style = ActiveDocument.Styles("Heading 3") Then
            Debug.Print rng.Words(1)
        'End If
        rng.Collapse Direction:=wdCollapseEnd
    Loop
End With

End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
hindersalivaAuthor Commented:
Martin, that works. And it takes the same length of time as my original Find code. So that's brilliant.

I've tried to understand what makes it 'not get stuck at the table'. Here's my original Find code.
        With rngContent.Find
         .ClearFormatting
         .Style = "Heading 3"
         .Execute Forward:=True
        End With

Open in new window

0
Martin LissOlder than dirtCommented:
Try this
    With rngContent.Find
         .ClearFormatting
         .Forward:=True
         .Style = "Heading 3"
         .Execute 
    End With

Open in new window

or
    With rngContent.Find
         .ClearFormatting
         .Forward:=True
         .Wrap = wdFindStop
         .Style = "Heading 3"
         .Execute 
  End With

Open in new window

0
hindersalivaAuthor Commented:
Thanks Martin. Strange. It won't let me put .Forward:=True .... but I did run your code with that modification in ID: 42471986 as above (2 days ago)!
Error
This is weird!
Any ideas why?
Thanks
0
hindersalivaAuthor Commented:
Ooooops! Sorry.
Should be (of course!)
Forward = True

!!!!!!!!!!!!!!!!
0
hindersalivaAuthor Commented:
Ok. My code now works. Super. I never found out why the table interfered with the Find. My guess is that I didn't qualify the Find enough, having used only minimal code.

Thanks for your help, Martin.
0
Martin LissOlder than dirtCommented:
You’re welcome and I’m glad I was able to help. It's also nice when I learn something along the way as I did here.

If you expand the “Full Biography” section of my profile you’ll find links to some articles I’ve written that may interest you.

Marty - Microsoft MVP 2009 to 2017
              Experts Exchange Most Valuable Expert (MVE) 2015, 2017
              Experts Exchange Top Expert Visual Basic Classic 2012 to 2017
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VBA

From novice to tech pro — start learning today.