Using VBA to Find and Replace Phrases in Word with Text from Excel Cell

[Fromlostdays1]

As stated, I'm trying to have Excel scan a specific cell for text, and use that text to replace every instance of another text in Word.

I have Excel creating a new Word document based on an existing word template I made per command button and deleting some bookmarks. I can't, however, figure out how to get the find and replace code to work.

For instance, I have a cell in Excel, lets just say A1, wherein I want to be able to fill in a Company name. Lets say, Company, Inc.
On my command button press, I'd like VBA to read what's in A1 (in this example Company, Inc.) and replace every instance of the text "[Company]" that I have in my word template.

This is the code I have so far. It doesn't error out, nothing to Debug, it just doesn't actually do the find and replace in the Word document. Also please note that the Replacement.Text in the below code "This Works!" was just me testing. Again, what I'm really working toward is having the replacement text be read from a cell in Excel.

Private Sub CommandButton1_Click()

Dim wdapp As Object
Dim wddoc As Object
Dim Path As String
Set wdapp = CreateObject("Word.application")
wdapp.Visible = True
Path = ThisWorkbook.Path & "\leguinst.docx"
Set wddoc = wdapp.Documents.Open(Path)

With wddoc.Content.Find
        .Text = "[Company]"
        .Replacement.Text = "This Works!"
        .Wrap = wdFindContinue
        .Execute Replace:=wdReplaceAll
End With

End Sub

Again, I can run this and no errors, the Word template opens, but nothing else happens after that. Any help would be appreciated.

Thanks!

Thanks!

 

[kevin9999]

This worked for me. I put the text "This works" in cell A1 of the Excel file & ran the macro.

Sub SearchReplace()

   Dim WordApp As Object, WordDoc As Object, ReplaceWord As String
   ReplaceWord = Range("A1").Value
   Set WordApp = CreateObject(Class:="Word.Application")
   Set WordDoc = WordApp.Documents.Open(ThisWorkbook.Path & "\leguinst.docx")
        
        With WordApp
           With WordDoc.Content.Find
                .Text = "Company"
                .replacement.Text = ReplaceWord
                .Forward = True
                .Wrap = wdFindContinue
                .Format = False
                .MatchCase = False
                .Execute Replace:=wdReplaceAll
          End With
        End With
        Documents.Save NoPrompt:=True, OriginalFormat:=wdOriginalDocumentFormat
End Sub

 

[Fromlostdays1]

Thanks for taking the time! It's not working over here though. When I run just your code, this line "Documents.Save NoPrompt:=True, OriginalFormat:=wdOriginalDocumentFormat" gets flagged by the debugger every time and it won't run. If I delete that line and run it, it seems like it might try to open 2 copies of the word document... as one version of the word template leguinst.docx opens but it immediately gives the "would you like to open a read only copy", and even when I cancel and close that there's another instance of Word running in task manager that I have to close down.

I'm not sure how much you can see in the code, but basically I have one portable directory called LegUI. Inside that that directory I have LegUI.xlsb and LegUINST.docx. Obviously I'm running the code from the .xlsb, wanting to open a copy of the .docx file, delete a bunch of bookmarks based on various Excel values (which works great), but also replace a few texts I have setup in the .docx that will vary between document. I set them up like [Company] and [Address] in the document so that I could do a quick manual find and replace. Now I'm trying to automate it based on a value in a cell in Excel.

I then spent a long time trying to read and understand your code and modify it a little bit so that it didn't error out, changed WordDoc to wdapp etc. to match the original code (though I'm not sure if that matters except that the delete bookmarks codes call wddoc and there's 37 pages of them haha) and so I could add multiple find and replace parameters.

This is what I landed on:

Private Sub CommandButton1_Click()

Dim wdapp As Object
Dim wddoc As Object
Dim companyname As String
companyname = Range("D7").Value
Dim companyaddress As String
companyaddress = Range("D8").Value
Set wdapp = CreateObject("Word.application")
wdapp.Visible = True
Set wddoc = wdapp.Documents.Open(ThisWorkbook.Path & "\leguinst.docx")

        With wdapp
           With wddoc.Content.Find
                .Text = "[Company]"
                .replacement.Text = companyname
                .Forward = True
                .Wrap = wdFindContinue
                .Format = False
                .MatchCase = False
                .Execute Replace:=wdReplaceAll
          End With
        End With
 
        With wdapp
           With wddoc.Content.Find
                .Text = "[Address]"
                .replacement.Text = companyaddress
                .Forward = True
                .Wrap = wdFindContinue
                .Format = False
                .MatchCase = False
                .Execute Replace:=wdReplaceAll
          End With

However, I'm essentially back to where I started. No errors, everything works in terms of opening the Word doc and deleting the bookmarks, but the Find and Replace isn't working at all. That it worked for you suggests to me at least that its something to do with "Documents.Save NoPrompt:=True, OriginalFormat:=wdOriginalDocumentFormat" which always errors out for me. Thanks for reading this far and I appreciate any more guidance on this!

 

[kevin9999]

Thanks for your detailed response. I don't know if I can be of much further use - Word is not my forte. When I remove that troublesome line of code, it still works for me. Perhaps we're not talking about trying to do the same type of thing. The demo below has a Word page with [Company] in various places before and after running the code.
This code:

Sub SearchReplace_2()

   Dim WordApp As Object, WordDoc As Object, ReplaceWord As String
   ReplaceWord = Range("D7").Value
   Set WordApp = CreateObject(Class:="Word.Application")
   Set WordDoc = WordApp.Documents.Open(ThisWorkbook.Path & "\leguinst.docx")
        
        With WordApp
           With WordDoc.Content.Find
                .Text = "[Company]"
                .replacement.Text = ReplaceWord
                .Forward = True
                .Wrap = wdFindContinue
                .Format = False
                .MatchCase = False
                .Execute Replace:=wdReplaceAll
          End With
        End With
End Sub

With this value on the active sheet

Test Word.xlsm
	C	D	E
6
7		This works
8
Sheet1

Turns this

Into this

If this is not exactly what you're after then I'm completely on the wrong track. The only other thing I could suggest is to use Mail Merge functionality to achieve the result you're after?
Sorry I can't be more help - hopefully someone else on the forum will step in and assist

 

[Fromlostdays1]

First and foremost, THANK YOU for putting in the time with me to help. I got it working and also feel like an idiot and have regrets.

Just to be clear, this is the code that works. Its the one I borrowed from you and manipulated a bit:

Private Sub CommandButton1_Click()

Dim wdapp As Object
Dim wddoc As Object
Dim companyname As String
companyname = Range("D7").Value
Dim companyaddress As String
companyaddress = Range("D8").Value
Set wdapp = CreateObject("Word.application")
wdapp.Visible = True
Set wddoc = wdapp.Documents.Open(ThisWorkbook.Path & "\leguinst.docx")

        With wdapp
           With wddoc.Content.Find
                .Text = "[Company]"
                .replacement.Text = companyname
                .Forward = True
                .Wrap = wdFindContinue
                .Format = False
                .MatchCase = False
                .Execute Replace:=wdReplaceAll
          End With
        End With
 
        With wdapp
           With wddoc.Content.Find
                .Text = "[Address]"
                .replacement.Text = companyaddress
                .Forward = True
                .Wrap = wdFindContinue
                .Format = False
                .MatchCase = False
                .Execute Replace:=wdReplaceAll
          End With

I could not have done that on my own. Early on into my foray into this, I followed a guide that told me to make sure the Microsoft Word 16.0 Object Library was checked in the references options, which I did. Which I thought I did. I opened references, saw it was checked, and moved on. Unfortunately for who knows how many hours of struggling with this, what was actually checked was Microsoft OFFICE 16.0 Library. Because you're code was working for you, I started thinking it had to be something else besides the code, and went back to beginners tutorials etc. and finally I decided to double check to see if that Library was activated. Once I activated the above code worked instantly. Thank you for all your help!

A little extra info just in case you are curious: the code you post still doesn't work for me even after I checked the Word library. Its the same result, like it's trying to open 2 word docs at the same time. I'm almost curious enough to try and figure that out since I'll probably learn something, but I'm also eager to finish this project. My only guess is that maybe it has something to do with me being on a Virtual Desktop for my work environment. At any rate, I can't thank you enough.

 

[kevin9999]

First and foremost, THANK YOU for putting in the time with me to help. I got it working and also feel like an idiot and have regrets.

Just to be clear, this is the code that works. Its the one I borrowed from you and manipulated a bit:

Private Sub CommandButton1_Click()

Dim wdapp As Object
Dim wddoc As Object
Dim companyname As String
companyname = Range("D7").Value
Dim companyaddress As String
companyaddress = Range("D8").Value
Set wdapp = CreateObject("Word.application")
wdapp.Visible = True
Set wddoc = wdapp.Documents.Open(ThisWorkbook.Path & "\leguinst.docx")

        With wdapp
           With wddoc.Content.Find
                .Text = "[Company]"
                .replacement.Text = companyname
                .Forward = True
                .Wrap = wdFindContinue
                .Format = False
                .MatchCase = False
                .Execute Replace:=wdReplaceAll
          End With
        End With
 
        With wdapp
           With wddoc.Content.Find
                .Text = "[Address]"
                .replacement.Text = companyaddress
                .Forward = True
                .Wrap = wdFindContinue
                .Format = False
                .MatchCase = False
                .Execute Replace:=wdReplaceAll
          End With

I could not have done that on my own. Early on into my foray into this, I followed a guide that told me to make sure the Microsoft Word 16.0 Object Library was checked in the references options, which I did. Which I thought I did. I opened references, saw it was checked, and moved on. Unfortunately for who knows how many hours of struggling with this, what was actually checked was Microsoft OFFICE 16.0 Library. Because you're code was working for you, I started thinking it had to be something else besides the code, and went back to beginners tutorials etc. and finally I decided to double check to see if that Library was activated. Once I activated the above code worked instantly. Thank you for all your help!

A little extra info just in case you are curious: the code you post still doesn't work for me even after I checked the Word library. Its the same result, like it's trying to open 2 word docs at the same time. I'm almost curious enough to try and figure that out since I'll probably learn something, but I'm also eager to finish this project. My only guess is that maybe it has something to do with me being on a Virtual Desktop for my work environment. At any rate, I can't thank you enough.

The main thing is that you got there in the end. Happy to have helped, and thanks for the feedback.

 

[aranjan]

Hi guys- just a quick question regarding this code.

I've been trying to use some of this for a macro I'm trying to implement. I was just wondering if its possible to collate multiple text replacement fields into one With statement. In the code that you share it seems like you've used two seperate With statements for [Company] and [Address], which works fine. However, when I've implemented my macro in this way, with multiple text fields I found that it really lengthens the execution time, and sometimes causes a runtime error. I was wondering if its functional to use just 1 large with statement with multiple textfields, and also a variable storing a value in range to replace text rather than something hard coded. Need some help in how to optimally implement these changes.

Thanks, this has been a useful and informative thread.