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

[Mite]

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:

25802

subject document to be populated

25803

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

Thanks in advance.

[gmayor]

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.



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

[Mite]

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:

25804

[gmayor]

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.


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.


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