VBA Select Range in Word Doc then Paste Range in Excel

Question

I have multiple documents that contain list of Equipment and Procedures for different Methods. I want a code that can do the following:

1st: Locate a given Method Number in Word Doc

2nd: Look right after Method number to determine which comes first, "Equipment -" or "Procedure and Evaluation -". "Equipment -", if present will always come before "Procedure and Evaluation -", but if "Procedure and Evaluation -" is first, then "Equipment -" will not be present.

3rd: Copy the range of text between "Equipment -" and "Procedure and Evaluation -" (if "Equipment -" is present) and paste to Excel

4th: Copy the range of text between "Procedure and Evaluation -" and "Design", and paste to Excel. ("Design" is the word that indicates the end of the Method Number)

Unfortunately, I am not good at going between Excel and Word, and I know the code below has numerous issues. The use of "rng.Find" does not seem to be allowed the way I am using it, along with multiple other things I'm sure. Any help to point me in the direction of being able to locate which word comes first in a document, and being able to transfer a range of text, based on specific words, to Excel would be greatly appreciated.

    Sub Find_and_Copy()
        Dim oWord As Word.Application
        Dim oWdoc As Word.Document
        Dim LastRow As Integer
        Dim i As Integer
        Dim rng As Range
        Dim rng1 As Range
        Dim rng2 As Range
        Dim rng3 As Range
        Dim Text1 As String
        Dim Text2 As String
        
        Set oWord = Word.Application
        Set oWdoc = oWord.Documents.Open("C:\Test.docx")
        Set rng = oWdoc.Range
    
        LastRow = Sheets("Temp").Cells.SpecialCells(xlCellTypeLastCell).Row
    
        'Loop through rows searching for the Method Number, Equipment, Procedure, & Design
        'Start on Row 4
        For i = 4 To LastRow
            'Check to make sure cell is not blank, if it is, then go to next iteration
            If Sheets("Temp").Cells(i, 6).Value = "" Then
                GoTo NextIteration
            End If
               
            'Set the Method Number to find
            strFnd = Sheets("Temp").Cells(i, 6).Value & "."
    
'Locate the Method Number and transfer the text between (but not including) "Equipment -" & "Procedure and Evaluation -" and "Procedure and Evaluation -" & "Design" if they both appear.
'I don't know how to check if Equipment - comes before "Procedure and Evaluation"
            If rng.Find.Execute(FindText:=strFnd) Then
                Set rng1 = oWdoc.Range(rng.End, oWdoc.Range.End)
                If rng1.Find.Execute(FindText:="Equipment -") Then
                    Set rng2 = oWdoc.Range(rng1.End, oWdoc.Range.End)
                    If rng2.Find.Execute(FindText:="Procedure and Evaluation -") Then
                        Text1 = oWdoc.Range(rng1.End, rng2.Start).text
                        Set rng3 = oWdoc.Range(rng2.End, oWdoc.Range.End)
                        If rng3.Find.Execute(FindText:="Design") Then
                            Text2 = oWdoc.Range(rng2.End, rng3.Start).text
                        Else
                            Text2 = ""
                        End If
                    ElseIf rng2.Find.Execute(FindText:="Desing") Then
                        Text1 = oWdoc.Range(rng1.End, rng2.Start).text
                    End If
                ElseIf rng1.Find.Execute(FindText:="Procedure and Evaluation -") Then
                    Set rng2 = oWdoc.Range(rng1.End, oWdoc.Range.End)
                    If rng2.Find.Execute(FindText:="Design") Then
                        Text2 = oWdoc.Range(rng1.End, rng2.Start).text
                    Else
                        Text2 = ""
                    End If
                Esle
                    Text1 = ""
                    Text2 = ""
                    GoTo NextIteration
                End If
            End If
        
            Sheets("Temp").Cells(i, 6).Value = Text1
            Sheets("Temp").Cells(i, 7).Value = Text2
        
        Next
    
Cleanup:
        oWdoc.Close
        Set oWdoc = Nothing
        
        oWord.Quit
        Set oWord = Nothing
          
    
    End Sub

Update to Question: Here is an example of the Word Doc

Method Number: 11111.1

A. Procedure and Evaluation - aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa

1. Alkjaasdlkajghlja
2. Jlasjdfkjasd;lfjlakdjs

Design

-----Page Break----

Method Number: 22222.2

A. Equipment - bbbbbbbbbbbbbbbbbbbbbbbbbbb

1. asdfasdf
2. asdfasf
3. asdfasdf
4. asdfadf
5. asdfasdf

B. Procedure and Evaluation - cccccccccccccccccccccccccccccccccccc.

1. Asdfasdfasdfasdf

Design

----Page Break-----

If I am looking for Method Number: 11111.1, then I want the code to be able to take information from "Procedure and Evaluation -" and place that in Column 7. For Method Number: 22222.2, I want the code to be able to take the text in "Equipment -" and place it in Column 6, and place the "Procedure and Evaluation -" text in Column 7 again.

Notes about Document:
-The Method Number is located in a textbox, the rest of the text is normal -There is a page break between Methods

Answer 1

Assuming all the expressions must be present, in the order you specified, try:

Sub Find_and_Copy()
Application.ScreenUpdating = False
Dim oWord As Word.Application, oWdoc As Word.Document
Dim xlWkSht As Worksheet, i As Long
Dim Text1 As String: Text1 = ""
Dim Text2 As String: Text2 = ""
Dim Text3 As String: Text3 = ""
Dim Fnd1 As String
Const Fnd2 As String = "Equipment -"
Const Fnd3 As String = "Procedure and Evaluation -"
Const Fnd4 As String = "Design"

Set xlWkSht = Sheets("Temp")

Set oWord = New Word.Application
Set oWdoc = oWord.Documents.Open("C:\Test.docx")

With xlWkSht
  'Loop through rows searching for the Method Number, Equipment, Procedure, & Design
  'Start on Row 4
  For i = 4 To .Cells.SpecialCells(xlCellTypeLastCell).Row
    'Check to make sure cell is not blank, if it is, then go to next iteration
    If .Cells(i, 6).Value <> "" Then
               
      'Set the Method Number to find
      Fnd1 = Sheets("Temp").Cells(i, 6).Value & "."
      With oWdoc.Range
        With .Find
          .ClearFormatting = True
          .Replacement.ClearFormatting = True
          .Replacement.Text = ""
          .Forward = True
          .Format = False
          .Wrap = wdFindStop
          .MatchWildcards = True
          .Text = Fnd1 & "*" & Fnd2 & "*" & Fnd3 & "*" & Fnd4
          .Execute
        End With
        If .Find.Found = True Then
          Text1 = Split(Split(.Text, Fnd1)(1), Fnd2)(0)
          Text2 = Split(Split(.Text, Fnd2)(1), Fnd3)(0)
          Text3 = Split(Split(.Text, Fnd3)(1), Fnd4)(0)
        End If
      End With
    End If
    xlWkSht.Cells(i, 7).Value = Text1
    xlWkSht.Cells(i, 8).Value = Text2
    xlWkSht.Cells(i, 9).Value = Text3
  Next
End With

oWdoc.Close False: oWord.Quit
Set oWdoc = Nothing: Set oWord = Nothing: Set xlWkSht = Nothing
Application.ScreenUpdating = True
End Sub

Note that I've changed your workbook output columns; it seemed inconsistent to me that you'd be searching for something in column 6, then replacing it with a blank or the found text.

Answer 2

try change in macropod's code .ClearFormatting' = True .Replacement.ClearFormatting' = True this should move you a step further.