1 Attachment(s)
Replace multiple repeated texts in multiple word documents from excel with excel vba
Attachment 24559
Hi I have just started with VBA and am trying to create an excel macro that can open and replace text in multiple word document templates.
It looks something like the picture:
Blue replaces B
Red replaces A
Cute replaces C
etc.
I have
1) many many variables of "blue", "Red", "Cute", "Awesome", "this is an old woman", "a paragraph of words" etc. on the excel sheet
2) about 10 different word document templates that requires the replacements to be performed
3) Not all the variables are required for all the 10 word documents
Have searched online and tried to amend various codes but not getting it. Here are some of the codes I found which I have tried the amend to get it to work, but to no avail.
Any suggestions? Thanks!
Code:
Sub replacetext()
Dim ws As Worksheet
Dim objWord As Object
Dim strValue As String
Set ws = ThisWorkbook.Sheets("Sheet1")
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
objWord.Documents.Open "C:\...\...\test.docx"
objWord.Activate
Set strValue = Range("...").Value
With objWord.Content.Find
.Text = "Normal"
.Replacement.Text = strValue
.Execute Replace:=wdReplaceAll
End With
End Sub
Code:
Sub Multi_FindReplace()
'PURPOSE: Find & Replace a list of text/values throughout entire workbook
'SOURCE: www.TheSpreadsheetGuru.com/the-code-vault
Dim sht As Worksheet
Dim objWord As Object
Dim fndList As Variant
Dim rplcList As Variant
Dim x As Long
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
objWord.Documents.Open "C:\...\...\test.docx"
objWord.Activate
fndList = Array("Canada", "United States", "Mexico")
rplcList = Array("CAN", "USA", "MEX")
With objWord.Content.Find
.Text = "Normal"
.Replacement.Text = strValue
.Execute Replace:=wdReplaceAll
'Loop through each item in Array lists
For x = LBound(fndList) To UBound(fndList)
'Loop through each worksheet in ActiveWorkbook
For Each sht In ActiveWorkbook.Worksheets
sht.Cells.Replace What:=fndList(x), Replacement:=rplcList(x), _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False
Next sht
Next x
End Sub
