Searching multiple ranges in one word.doc with results pasted to subject word doc.

Hi all,
I'm trying to streamline a process whereby creating a macro in word to search for string ranges in a title document so that the results of such searches are copied and pasted in the subject document to avoid copying errors.

I've created the code to search and open the dialogue box so that the user can select the appropriate word search document.

Set objDoc = ActiveDocument

Set dlgOpen = Application.FileDialog(FileDialogType:=msoFileDialogOpen)
TCtitledoc = False
Do Until TCtitledoc = True
With dlgOpen
.AllowMultiSelect = True
.Show
If .SelectedItems.Count > 0 Then
TCtitle = .SelectedItems(1)
Else
MsgBox "Please select a title search document to use for processing"
End If
End With
If InStr(1, TCtitle, ".doc") > 0 Then
'proceed
TCtitledoc = True
Else
MsgBox "The file must be a valid word doc. file. Try again please..."
End If
Loop

Application.ScreenUpdating = False
blnClosetitlesearch = True

I've also attempted to create the string search code for one aspect, but struggling to reference bookmarks in the original document and linking it all together.

Search Document below:

Attachment 25802

subject document to be populated

Attachment 25803

Appreciate anyone's help that knows more about it than me.

Thanks in advance.

There are some issues with your file open routine - call the following function to select and open a document instead. However your main query is not at all clear. You have given little indication what it is you are searching and what you are searching for so difficult to assist. You also mention bookmarks, without any indication of what they are and where they are located or their relevance.

Code:

---

Function BrowseForFile(Optional strTitle As String) As String
'Graham Mayor - https://www.gmayor.com
'strTitle is the title of the dialog box
'The default is to show Word files
Dim fDialog As FileDialog
    On Error GoTo err_Handler
    Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
    With fDialog
        .TITLE = strTitle
        .AllowMultiSelect = False
        .Filters.Clear
        .Filters.Add "Word documents", "*.doc,*.docx,*.docm"
        .InitialView = msoFileDialogViewList
        If .Show <> -1 Then GoTo err_Handler:
        BrowseForFile = fDialog.SelectedItems.Item(1)
    End With
lbl_Exit:
    Exit Function
err_Handler:
    BrowseForFile = vbNullString
    Resume lbl_Exit
End Function

---

thanks for the response and sorry for not being clearer.

To clarify, I've included bookmarks in the table next to Title Reference; Description; Registered Proprietor; Encumbrances; Administrative Advices; and Unregistered Dealings assuming that the VBA code would reference these bookmarks in order to paste the results in the correct locations.

My goal is for the marco to populate the Subject word document as per the example originally provided:

Attachment 25804

The following function will write any text value (strValue) it is supplied with to a named bookmark (strbmName) in the document (oDoc.) Call it from your search.

Code:

---

Public Sub FillBM(oDoc as document, strbmName As String, strValue As String)
'Graham Mayor - http://www.gmayor.com
Dim oRng As Range
    With oDoc
        On Error GoTo lbl_Exit
        Set oRng = .Bookmarks(strbmName).Range
        oRng.Text = strValue
        oRng.Bookmarks.Add strbmName
    End With
lbl_Exit:
    Set oRng = Nothing
    Exit Sub
End Sub

---

Basically you open the document, and search for the wanted data then write each piece of that data to the appropriate bookmark in the other document e.g. as follows, which should point the way.

Code:

---

Sub Macro1()
Dim oSource As Document, oTarget As Document
Dim oRng As Range
Dim sText As String
Set oTarget = ActiveDocument    'the document with the table and bookmarks)
    Set oSource = BrowseForFile("Select the document to search")
    Set oRng = oSource.Range

    With oRng.Find
        Do While .Execute(findText:="Dealing No:")
            oRng.Collapse 0
            oRng.End = oRng.Paragraphs(1).Range.End - 1
            sText = Split(oRng.Text, "/")(0)
            FillBM oTarget, "DealingNo", Trim(sText)
            Exit Do
        Loop
    End With

    Set oRng = oSource.Range
    With oRng.Find
        Do While .Execute(findText:="UNREGISTERED DEALINGS")
            oRng.Collapse 0
            oRng.End = oRng.Paragraphs(1).Range.End - 1
            sText = Split(oRng.Text, "-")(1)
            FillBM oTarget, "UnregisteredeDealings", Trim(sText)
            Exit Do
        Loop
    End With

lbl_Exit:
    Set oSource = Nothing
    Set oTarget = Nothing
    Set oRng = Nothing
    Exit Sub
End Sub

---