VBA in Excel to Word: Searching and Replacing

[kmh6278]

Hi,

I have a list of words maintained in Excel that will be used for searching and replacing in Word. I have code that originates in Excel, loads the list of words from the Excel file into an array, and then opens a Word file to search and replace for each word in that array. The code seems to work for the most part, however, the "replaceall" isn't working once in Word. Stepping through the code, everything seems to be working as intended until the last line.

Here is the code I am working with. Any help would be greatly appreciated as I am stuck!

[VBA]Sub SpellCheck()

Dim replace_text As String
Dim verbTemplateWord As Variant
Dim this_index As Variant, this_word As Variant, last_word As Variant
Dim DataList As Range, word_list As Variant

Set DataList = Sheets("Sheet2").Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
word_list = DataList.Value ' this is where it loads the values in column A

replace_text = "XXXXXX" 'replace items in word_list with this

'now need to switch to word
' this opens Word (object named wrdApp)
On Error Resume Next
Set wrdApp = GetObject("Word.Application")
If Err.Number <> 0 Then 'Word isn't already running
Set wrdApp = CreateObject("Word.Application")
End If
On Error GoTo 0


' COMMENT OUT (for debugging only)


wrdApp.DisplayAlerts = True
wrdApp.Visible = True ' can set this to true (and ScreenUpdating) for debugging
wrdApp.ScreenUpdating = True

' Open Word template
verbTemplateWord = "f:\home\kristin\reference\vba_test\SpellCheck Test.docx"
Set wrdDoc = wrdApp.documents.Open(verbTemplateWord)

'this block searches, finds but doesn't replace. for some reason, it highlights instead?
last_word = UBound(word_list)
For this_index = 1 To last_word ' the main loop through the word list
this_word = word_list(this_index, 1)

wrdApp.Selection.Find.ClearFormatting
wrdApp.Selection.Find.Replacement.ClearFormatting

With wrdApp.Selection.Find
.Text = this_word
.Replacement.Text = replace_text
.Forward = True
.Wrap = wdFindcontinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
wrdApp.Selection.Find.Execute Replace:=wdReplaceAll

Next this_index


End Sub[/VBA]

[mdmackillop]

Welcome to VBAX
I see what you mean and can't think of a reason.
As a workaround, I would try creating the macro in Word, then pass the variables to that macro to run.

[mancubus]

wellcome to vbax


pls refer to crossposting rules...

http://www.mrexcel.com/forum/showthread.php?t=592190

[macropod]

hi kmh,

Try:
[vba]Sub SpellCheck()
Dim replace_text As String
Dim verbTemplateWord As Variant
Dim this_index As Variant, this_word As Variant, last_word As Variant
Dim DataList As Range, word_list As Variant
Dim wrdApp As Word.Application, wrdDoc As Word.Document

Set DataList = Sheets("Sheet2").Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
word_list = DataList.Value ' this is where it loads the values in column A

replace_text = "XXXXXX" 'replace items in word_list with this

'now need to switch to word
' this opens Word (object named wrdApp)
On Error Resume Next
Set wrdApp = GetObject("Word.Application")
If Err.Number <> 0 Then 'Word isn't already running
Set wrdApp = CreateObject("Word.Application")
End If
On Error GoTo 0
With wrdApp
.DisplayAlerts = True
.Visible = True ' can set this to true (and ScreenUpdating) for debugging
.ScreenUpdating = False

' Open Word template
verbTemplateWord = "f:\home\kristin\reference\vba_test\SpellCheck Test.docx"
Set wrdDoc = .Documents.Open(verbTemplateWord)
'this block searches, finds but doesn't replace. for some reason, it highlights instead?
last_word = UBound(word_list)
For this_index = 1 To last_word ' the main loop through the word list
this_word = word_list(this_index, 1)
With wrdDoc.Content.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = this_word
.Replacement.Text = replace_text
.Forward = True
.Wrap = wdFindcontinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=wdReplaceAll
End With
Next this_index
.ScreenUpdating = True
End With
End Sub[/vba]