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!
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
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!
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
