blue red.jpg
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!
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 SubSub 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




Reply With Quote