Selecting text found in a find/replace macro

[UglyBob]

Hi guys,
I have a macro below that takes a two-column table in an external 'definition' document -- if something from the column 1 in the definition document is found in the active document, the user is prompted to replace it with the respective text from column 2 in the definition document.

Everything is working fine in this macro except I want to highlight/select the found text in the active document (so the user can see the context of the sentence to decide whether they replace or skip the particular word/phrase).

Sub ReplaceFromTableList()
Dim ChangeDoc, RefDoc As Document
Dim cTable As Table
Dim oFind, oReplace As Range
Dim i As Long
Dim sFname As String

'Define the document containing the table of words/phrases and their replacements
sFname = "C:\definitions.doc"

'Define the document to be processed
Set RefDoc = ActiveDocument

'Open the document with the changes
Set ChangeDoc = Documents.Open(sFname)

'Define the table to be used
Set cTable = ChangeDoc.Tables(1)

'Activate the document to be processed
RefDoc.Activate
For i = 1 To cTable.Rows.Count

'Define the cell containing the word/phrase to be replaced
Set oFind = cTable.Cell(i, 1).Range
oFind.End = oFind.End - 1

'Define the cell containing the replacement word/phrase
Set oReplace = cTable.Cell(i, 2).Range
oReplace.End = oReplace.End - 1
With Selection

'Start at the top of the document
.HomeKey wdStory

'Replace the words/phrases
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Execute

' Selection.Range.Select
' ^^^ HELP HERE!!

Msg = "Do you want to replace '" & oFind & "' with '" & oReplace & "'?"
style = vbYesNoCancel + vbQuestion + vbDefaultButton1
title = "Defined Term Found"
response = MsgBox(Msg, style, title)

'User chose yes, execute replacement
If response = vbYes Then
.Execute findText:=oFind, _
ReplaceWith:=oReplace, _
Replace:=wdReplaceAll, _
MatchWholeWord:=True, _
MatchWildcards:=False, _
MatchCase:=True, _
Forward:=True, _
Wrap:=wdFindContinue

'User cancels, kill the macro
ElseIf response = vbCancel Then
Exit Sub
End If

End With
End With
Next i

'Close the document with the definition table
ChangeDoc.Close wdDoNotSaveChanges

End Sub
I've not had much luck finding many details on .Select on the net. The closest I've got to a solution is getting the found term to be displayed/selected in the definition document (but I need it to select the text as found in the active document...)

Hopefully this is an easy fix and someone can tell me where I've gone wrong.

Thanks for your help!

[fumei]

Is your table with your terms huge? If it is not, then:

1. open the definitions doc
2. grab the terms from the table and put them into TWO arrays (one for column 1, one for column 2)
3. close the definitions doc. This returns the current doc as Active.
4. use the items (terms) of the arrays in your .Find operations.

[UglyBob]

Hi fumei,
Thanks heaps for your reply.

The definitions table/document will have 300-400 lines in it, so I think that's huge-ish! :)

The macro will be used among a team of 5-10 people, and I'm trying to keep the macro code separate from the definitions so that if new definitions need to be added, it can be managed and deployed across the team more easily. (ie. it is easier for individual users to copy a file to their local PC than it is for them to edit an array in a macro!)

If there's no way to select the found text when there are two documents open, could you help me with the code to build the definition array(s) then discard/close the definition document?

Thanks again for your help.

[Tinbendr]

'Replace the words/phrases
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Execute

if Selection.Find.Found then
Selection.select
end if

Untested.

I would close the With under the .Execute, then move the rest of the code into the If .Found then.

[fumei]

Hey Ugly...I think that is an OK handle...I guess.

OK, ready? Here we go. This will be, I hope, a good learning experience for you. The code is NOT difficult. As usual, it is the thinking, the logic, that takes the effort. The following is the code in the attach documents in the ZIP file. I will explain after.
Option Explicit
Public strList1()
Public strList2()
Public ThisDoc As Document

Function CellText(oCell As Cell)
CellText = Left(oCell.Range.Text, _
Len(oCell.Range.Text) - 2)
End Function

Sub BuildArrays()
Dim DefDoc As Document
Dim oTable As Table
Dim var
Dim j As Long

Set ThisDoc = ActiveDocument
' you MUST change the following path to where ever you put the
' definitions.doc file!!!
Set DefDoc = Documents.Open(FileName:="c:\zzz\Yadda\definitions.doc")
ThisDoc.Activate
j = 1
Set oTable = DefDoc.Tables(1)
For var = 0 To oTable.Rows.Count
ReDim Preserve strList1(var)
strList1(var) = CellText(oTable.Cell(j, 1))
j = j + 1
Next
var = 0
j = 1
For var = 0 To oTable.Rows.Count
ReDim Preserve strList2(var)
strList2(var) = CellText(oTable.Cell(j, 2))
j = j + 1
Next
DefDoc.Close wdDoNotSaveChanges
Call ActionArrayFind
End Sub

Sub ActionArrayFind()
Dim j As Long
Dim msg As String
Dim var

For var = 0 To UBound(strList1())
Selection.HomeKey Unit:=wdStory
With Selection.Find
.MatchWholeWord = True
Do While .Execute(FindText:=strList1(j), _
Forward:=True) = True
msg = "Do you want to change " & vbCrLf & vbCrLf & _
strList1(j) & _
" TO " & strList2(j) & "?" & vbCrLf & _
vbCrLf & "Click Yes to change, No to ignore."
Select Case MsgBox(msg, vbYesNoCancel)
Case vbYes
Selection.Text = strList2(j)
Selection.Collapse 0
Case vbNo
Selection.Collapse 0
Case Else
Selection.Collapse 1
Exit Sub
End Select
Loop
j = j + 1
End With
Next
End Sub
Ready? Take a breath...we are going to walk through it. Again, try to keep in mind that this code is easy...it is the thinking that may be a strain.

Option Explicit
Declare the PUBLIC variables. They are Public because I am using them in two different procedures. Why two procedures? It could be done in one, but good practice is to make your coding into manageable chunks. Thus there is one procedure to build the arrays, another one to action those arrays.

Public strList1()
Public strList2()
Public ThisDoc As Document

The Function that gets ONLY the text from a table cell. Otherwise getting the text from a cell range includes the end-of-cell marker…and trust me… that would screw things up. You only want the text!

Function CellText(oCell As Cell)
CellText = Left(oCell.Range.Text, _
Len(oCell.Range.Text) - 2)
End Function

The build array procedure. Declare the variables.
Sub BuildArrays()
Dim DefDoc As Document
Dim oTable As Table
Dim var
Dim j As Long


Make a document object of the ActiveDocument. Make a document object of Definitions.Doc. Return the current document as Active. This means you never see definitions.doc
Set ThisDoc = ActiveDocument
Set DefDoc = Documents.Open(FileName:="c:\zzz\Yadda\definitions.doc")
ThisDoc.Activate


Set the table object variable to the table in Definitions.doc. Note that you do NOT – repeat NOT – have to have the document Active.
j = 1
Set oTable = DefDoc.Tables(1)


Build the first column array (strList1). Again, note the use of the Function CellText to get only the text from the cell.
For var = 0 To oTable.Rows.Count
ReDim Preserve strList1(var)
strList1(var) = CellText(oTable.Cell(j, 1))
j = j + 1
Next

Reset the variables used to build the arrays.
var = 0
j = 1

Build the second array (strList2) for the second column.
For var = 0 To oTable.Rows.Count
ReDim Preserve strList2(var)
strList2(var) = CellText(oTable.Cell(j, 2))
j = j + 1
Next

Close Definitions.doc as you do not need it anymore.
DefDoc.Close wdDoNotSaveChanges

Call the procedures to action the arrays, When THAT has finished, end this procedure.
Call ActionArrayFind
End Sub


Here is the action the arrays procedure. Start off – as usual – by declaring the variables.
Sub ActionArrayFind()
Dim j As Long
Dim msg As String
Dim var


The following is how arrays are generally used. This instruction tells VBA to do the next series of actions for EVERY item in the array, starting with the first one. This means: use the first word of strList1 (column 1 of Definitions.doc table); do the search, then use the next word, then the next….etc.
For var = 0 To UBound(strList1())

For EACH unique word in the array, start at the start of the document.
Selection.HomeKey Unit:=wdStory

Search for the word.
With Selection.Find
.MatchWholeWord = True
Do While .Execute(FindText:=strList1(j), _
Forward:=True) = True

If Found, write the string used for the message, using the current search word (strList1), and its matching replacement (from column 2 of the Definitions.doc table – in the array strList2)
msg = "Do you want to change " & vbCrLf & vbCrLf & _
strList1(j) & _
" TO " & strList2(j) & "?" & vbCrLf & _
vbCrLf & "Click Yes to change, No to ignore."

The messagebox returns a value (user clicks Yes, No, or Cancel). Test it using Select Case. If Yes clicked, change the current selected text (from strList1) with the replacement text from strList2.
Select Case MsgBox(msg, vbYesNoCancel)
Case vbYes
Selection.Text = strList2(j)
Selection.Collapse 0
Case vbNo
Selection.Collapse 0
Case Else
Selection.Collapse 1
Exit Sub
End Select

Continue on to the next Found of the current search string (from strList1)
Loop

When the last Found for the current search word is found (or not), increment the counter – this means use the NEXT word.
j = j + 1
End With
Next

We is done
End Sub

[fumei]

I do not know how much it may affect performance, but I would certainly TRY and use an array of up to 300.

Oh, and an important assumption! The two column table in definitions.doc has ONLY - repeat ONLY - the text in each cell, AND the text is NOT terminated by a paragraph mark.

In each cell:

word

NOT

word<p> - the <p> means a paragraph mark. So make sure each word is NOT followed by an Enter keystroke.

[fumei]

" I'm trying to keep the macro code separate from the definitions so that if new definitions need to be added, it can be managed and deployed across the team more easily."

Yup. Good plan. This does that. The definitions file (and of course it can be named whatever you want as long as you make the change in the code) is completely independent of the code. It HAS no code. In other words, the definitions file can be updated/changed however you like - but as long as you keep the format structure. The code simply grabs column 1 cell text and builds an array; grabs the column 2 cell text and builds the second array.

OH, and the assumption is that column 1 has a matching text in column 2.

[fumei]

Wee correction.
Function CellText(oCell As Cell)

should be
Function CellText(oCell As Cell) As String