MS Word: Caputer Section Number In A Variable

Can you post the code you are using to find 'TBD'?

I am running this code from MS Access.


Dim FindRange As Word.Range
Set FindRange = ActiveDocument.Range

FindRange ' TBD"
Do While FindRange.Find.Execute() = True
        pdPage = FindRange.Information(wdActiveEndPageNumber)
        Selection.Goto wdGoToPage, wdGoToAbsolute, pdPage
        pageNumberText = FindRange.Sections(1).Footers(WdHeaderFooterIndex.wdHeaderFooterPrimary).Range.Text

        If FindRange.Sections(1).Footers(Word.WdHeaderFooterIndex.wdHeaderFooterPrimary).PageNumbers.NumberStyle = Word.WdPageNumberStyle.wdPageNumberStyleArabic Then

               'Capture the Section Number

        End If
Loop

Can't quite understand what you need. You say you need the section number, but the sample shows some text, nowhere near the target text (TDB) in the document. So let's start with this which augments your code to include the section number. If it doesn't fit your requirement , let us know where and how.

Option Explicit

Sub FindList()

    Dim pdPage As Integer
    Dim FindRange As Word.Range
    Dim pageNumberText As String
    
    Set FindRange = ActiveDocument.Range
    
    With FindRange.Find
        .Text = "TBD"
        Do While .Execute() = True
            pdPage = FindRange.Information(wdActiveEndPageNumber)
            Selection.GoTo wdGoToPage, wdGoToAbsolute, pdPage
            pageNumberText = Replace(FindRange.Sections(1).Footers(WdHeaderFooterIndex.wdHeaderFooterPrimary).Range.Text, vbCr, "")
    
            If FindRange.Sections(1).Footers(Word.WdHeaderFooterIndex.wdHeaderFooterPrimary).PageNumbers.NumberStyle = Word.WdPageNumberStyle.wdPageNumberStyleArabic Then
                MsgBox pdPage & ", " & pageNumberText & ", " & FindRange.Sections(1).Index
            End If
        Loop
    End With
End Sub

Select allOpen in new window

Here I store the start and end values of each section's range.  As I find a "TBD" I iterate this collection.  This solution example prints to the immediate window.  You can do whatever you want with the found/matched values.

Sub Q_29141810()
    Dim colSections As New Collection
    Dim vItem As Variant
    Dim rngFind As Range
    
    For Each vItem In ActiveDocument.Sections
        colSections.Add Array(vItem.Range.Start, vItem.Range.End, _
            getSentenceText(vItem.Range.Sentences(1)))
    Next
    
    Set rngFind = ActiveDocument.Range
    With rngFind.Find
        .Text = "TBD"
        Do While .Execute() = True
            For Each vItem In colSections
                If rngFind.Start < vItem(1) Then
                    Debug.Print getSentenceText(rngFind.Sentences(1))
                    Debug.Print , "Found in section: ", vItem(2)
                    Exit For
                End If
            Next
        Loop
    End With
End Sub

Function getSentenceText(ByVal parmsent As String) As String
    getSentenceText = Replace(parmsent, vbCr, vbNullString)
End Function

Select allOpen in new window

Hello.  Thanks for the responses.  Unfortunately, neither one gave me what I was looking for.

 aikimark:  You were the closest, but the code captured the wrong data and the capture was incomplete.
First of all, I don't need any additional loops.  I just need the code to go back up and capture the nearest Section Number and Text.
This is the result of you code:
[JYR] [WRTT] [MRG]  <TBD 1-4>
          Found in section:  AVENGEJET 6 REQUIREMENTS
<TBD 1-6>
          Found in section:  AVENGEJET 6 REQUIREMENTS
You captured AVENGEJET 6 REQUIREMENTS without the 1.1

I am looking for code something like this.
strSectionNumberText = Trim(Selection.Range.ListFormat.ListString) & " " & Selection.Paragraphs(1).Range.Text
 
In the example file I sent, when the first TBD is found,  <TBD 1-4>) I need code to go and capture:
1.1.2  AVENGERS TASKS (IN DESCENDING PRIORITIZED ORDER)
I need the number and the text.

The same when it finds the next TBD.

The actual document is 125 pages.

I hope I am asking the question correcctly.

Thanks
WonHop

Please double-check the document you posted.  There are only three sections.  There is a one character section near the start of the document and the following two sections.
1.0  REQUIREMENTS
1.1  AVENGEJET 6 REQUIREMENTS

Both of the "TBD" strings were in the third section.

1.1.2  AVENGERS TASKS (IN DESCENDING PRIORITIZED ORDER)

Is NOT a section

OOOhhh!!!!  Ok.  I am not good a coding in MS Word.  What is that part called and how do I get there?
Maybe I do need a loop of some kind.  Is there a way to go back up one whatever at a time.
 
Then I can use the InStr to find the empty space and LEN Function to check to see if the total equal to at least 3.

then go back to the original postion before it started moving up so that the search can continue.

Thanks
WonHop

I am not good a coding in MS Word

This isn't a matter of "coding".  There is no VBA code involved in marking (indicating) text as a section or a header.

There are paragraphs that do indicate they are different headers.  Is that what you mean?  Not "sections" but "headers"?

Maybe so.  I am not good with word. I was given this project and this is OJT for me.  :0)
The lady told me which parts to capture.  I have already captured a lot of what I need.  This part has been giving me trouble.
For the example that I gave here, I need a way to capture the 1.1.2  AVENGERS TASKS (IN DESCENDING PRIORITIZED ORDER) .
I will need to find TBDs and whatever that number is called above it several times in the document.

THis code assumes that you want to display the previous paragraph with the style 'Heading 3''

Sub FindList1()

    Dim pdPage As Integer
    Dim FindRange As Word.Range
    Dim para As Paragraph
    Set FindRange = ActiveDocument.Range
    Dim FindHeadingRange As Range
    With FindRange.Find
        .Text = "TBD"
        Do While .Execute() = True
            pdPage = FindRange.Information(wdActiveEndPageNumber)
            Set FindHeadingRange = ActiveDocument.Range
            FindHeadingRange.End = FindRange.Start
            With FindHeadingRange.Find
                .Style = "Heading 3"
                If .Execute(Forward:=False) Then
                    Set para = FindHeadingRange.Paragraphs.First
                    MsgBox "Page: " & pdPage & ",   Section: " & para.Range.ListFormat.ListString & " " & para.Range.Text
                End If
            End With
        Loop
    End With
End Sub

Select allOpen in new window

Hello Graham.  Thanks for the response:
First, on the small sample document, the code below gives me what I need.
   msgbox "Page: " & pdPage & ",   Section: " & para.Range.ListFormat.ListString & " " & para.Range.Text
  strHeader3Captured = para.Range.ListFormat.ListString & " " & para.Range.Text

The problem is (I really hope I can explain this correctly), there is too much code.  The full set of code you sent loops thru and finds them all.
I already have code that loops thru and finds them one by one.  When they are found, I capture data for about 10 or so fields that I add to the MS Access Database.  When I add your code with mine, it always start at the beginning. So only the data for the first TBD is the only one that is captured in the database over and over.

When I run it on the big document, I get the wrong data.  Let me play with it on Monday.  Now that I know I am looking for a style,  I will see about using what you sent and hopefully changing it to get what I need where I need it.
You might not hear back from me until Tuesday.  

Thanks
WonHop

Please test this

Sub Q_29141810()
    Dim colHeadings As New Collection
    Dim vItem As Variant
    Dim rngFind As Range
    Dim paraThing As Paragraph
    Dim lngLoop As Long
    Dim boolMatched As Boolean
    
    For Each paraThing In ActiveDocument.Paragraphs
        If paraThing.Format.Style Like "Heading *" Then
            colHeadings.Add Array(paraThing.Range.Start, _
                        paraThing.Range.End, _
                        paraThing.Range.Text)
        End If
    Next
    
    Set rngFind = ActiveDocument.Range
    With rngFind.Find
        .Text = "TBD"
        Do While .Execute() = True
            For lngLoop = 1 To colHeadings.Count
                If rngFind.Start < colHeadings(lngLoop)(0) Then
                    Debug.Print getSentenceText(rngFind.Sentences(1))
                    Debug.Print , "Found in section: ", colHeadings(lngLoop - 1)(2)
                    boolMatched = True
                    Exit For
                End If
            Next
            If boolMatched Then
            Else
                Debug.Print getSentenceText(rngFind.Sentences(1))
                Debug.Print , "Found in section: ", colHeadings(lngLoop - 1)(2)
            End If
        Loop
    End With
End Sub

Function getSentenceText(ByVal parmsent As String) As String
    getSentenceText = Replace(parmsent, vbCr, vbNullString)
End Function

Select allOpen in new window

I have to leave now.  I will try it on Monday.  
Thank you both for your help.
WonHop

Hello guys.  I am still trying your responses on both the real document and fake document to check the results.
aikimark.  Your code did fine the header below.
AVENGERS TASKS (IN DESCENDING PRIORITIZED ORDER)

But it did not capture the number 1.1.2  I need for that to be captured also.
I will continue to work on this on Wednesday.

Thanks
WonHop

Hello guys.  You were correct.  I was asking the WRONG question.  The lady I an doing this for was out for a few days and she is back now.
She said that I need to find the Header (the Header number 1or 2 or 3 does not matter) that is directly above the TBD that is found.
Then capture the data in that header.  aikimark, the last code you sent does capture the correct header with header number.  The problem so far is the it loops thru and find them all at one time before it moves on.
Please bear with me while I try to explain what I need.  I am showing more code below to give you a better picture of what I am doing?

BIG PICTURE:  WHAT I NEED HERE IN THIS QUESTION IS FOR THE DATA IN THE HEADER TO  BE CAPTURED IN A VARIABLE.  iT WILL FIND THE TBD THAT IS NOT IN A TABLE.  I already have code to capture the TBD and TBD Number.  One part of the code below finds the TBD in the a table.  The other part of the code finds the TBD that in not in a table.

Below is the link to another question I received an answer for on this same task.  But is was to get data that is in a table.

MS Word.  Capture the Table Title
https://www.experts-exchange.com/questions/29136176/MS-Word-Capture-the-Table-Title.html?headerLink=workspace_answered_questions

The code loops thru the document looking for TBDs.  The code first looks to see if it is in a table.  If it is in the table it captures certain data like the row, column, table name, page number, etc,
If it is not in a table then I need for it to capture that data that I am ask for in this question.  I need for the Header number to be captured one at a time, then added to the database and then looks for the next TBD.  It could be in a table or in the body.


FindRange ' TBD"
Do While FindRange.Find.Execute() = True
        pdPage = FindRange.Information(wdActiveEndPageNumber)
        Selection.Goto wdGoToPage, wdGoToAbsolute, pdPage
        pageNumberText = FindRange.Sections(1).Footers(WdHeaderFooterIndex.wdHeaderFooterPrimary).Range.Text

        'FINDS DATA THE THE MS WORD TABLE AND CAPTURES IT IN VARIABLES
        If FindRange.Information(Word.WdInformation.wdWithInTable) = True Then  
            strColumn = FindRange.Information(wdStartOfRangeColumnNumber)
            strRow = FindRange.Information(wdStartOfRangeRowNumber)
            FindRange.Tables(1).Cell(1, 1).Select
            Selection.Previous(wdParagraph, 1).Select
            Selection.MoveLeft wdCharacter, 1, wdExtend
            strTableTitle = Selection.Text

            'PUT DATA IN THE DATABASE TABLE AND CONTINUES SEARCHING THE DOCUMENT FOR THE NEXT TBD..
           With rsttblFirstOccurrencesReport
               .AddNew
               !txt_Term_TBD = "TBD"
               !txt_Context_Body_TBD = strContextBodyFOR
               !num_Section_Quantity_Found = intrstTBDSectionWithDashCount
               !txt_Section_With_Dash_TBD = strInStrAfterTBDSearch
               !num_MS_Word_Section_Number_TBD = intMSWordSectionNumber
               .Update
           End With
         End if


        'YOUR CODE!!!!
        'ONCE IT FINDS DATA THAT IS NOT THE THE MS WORD TABLE.  CAPTURES IT IN VARIABLES

        'THIS CODE FIND TBD THAT ARE NOT IN A MS WORD TABLE.
        If FindRange.Sections(1).Footers(Word.WdHeaderFooterIndex.wdHeaderFooterPrimary).PageNumbers.NumberStyle = Word.WdPageNumberStyle.wdPageNumberStyleArabic Then
            '=========================================================================================
            YOUR CODE!!!!
            Once the TBD is found, capture the Header Data.  Store it in a variable so that it can be added as a new row in the MS Access Database.
            strHeader = colHeadings(lngLoop - 1)(2)
            Once the Header Data is captured, make sure to set focus or fix it so that it continues from the last found Found TBD for the next search.  It could be in a Table of the just the Body.
            '=========================================================================================

            'PUT DATA IN THE DATABASE TABLE AND CONTINUES SEARCHING THE DOCUMENT FOR THE NEXT TBD..
           With rsttblFirstOccurrencesReport
               .AddNew
               !txt_Term_TBD = "TBD"
               !txt_Context_Body_TBD = strContextBodyFOR
               !num_Section_Quantity_Found = intrstTBDSectionWithDashCount
               !txt_Section_With_Dash_TBD = strInStrAfterTBDSearch
               !num_MS_Word_Section_Number_TBD = intMSWordSectionNumber
               .Update
           End With
         End if

Loop

Hello guys.  I am going to close this question and ask it again now that I know what to ask for.
aikimark, i am awarding you the points because your code did capture the data in the header I was to capture.
I just need to capture it one at time and not all at once.

Thanks for all of your help.

WonHop