CODEWITHSUNDEEP
excelvbams-word
user3890641
user3890641

Reputation: 13

VBA Excel/Word Find and Replace

I'm developing an Excel sheet to search in a Word document for a specific instance (Column A) and replace them by the instance in cell B.

I want to change only the first instance that matches the search criteria, and keep looping trough the column to the next instances.

I've written the code below.

If I use "wdReplaceAll" it replaces all the specific instance in the Word document. If I use wdReplaceOne" the code will break after the first change.

VBA Code:

Sub Replace()

Dim pathh As String
Dim pathhi As String
Dim oCell  As Integer
Dim from_text As String, to_text As String
Dim WA As Object

pathh = "C:\Users\Rui.Fernandes\Arquivo Rui Fernandes\On.me Documentação\Construção\Documentos Obra Tipo\PGC.10.Ed.1 - Auditorias Internas.doc"

Set WA = CreateObject("Word.Application")
WA.Documents.Open (pathh)
WA.Visible = True

For oCell = 1 To 10
    from_text = Sheets("PTAct").Range("A" & oCell).Value
    to_text = Sheets("PTAct").Range("B" & oCell).Value
    With WA
        .Activate
    With .Selection.Find
      .ClearFormatting
      .Replacement.ClearFormatting

      .Text = from_text
      .Replacement.Text = to_text
      .Execute Replace:=wdReplaceAll
    End With
End With
Next oCell

End sub

How can I do make it do what I want?

Upvotes: 1

Views: 16317

Answers (1)

Axel Richter
Axel Richter

Reputation: 61870

You do late binding, so wdReplaceAll and wdReplaceOne will not be what you expect. Look in Word VBA help for the WdReplace Enumeration and its values.

Sub Replace()

Dim pathh As String
Dim pathhi As String
Dim oCell  As Integer
Dim from_text As String, to_text As String
Dim WA As Object

pathh = "C:\Users\axel\Documents\replacetest.docx"

Set WA = CreateObject("Word.Application")
WA.Documents.Open (pathh)
WA.Visible = True

For oCell = 1 To 10
    from_text = Sheets("PTAct").Range("A" & oCell).Value
    to_text = Sheets("PTAct").Range("B" & oCell).Value
    With WA.ActiveDocument
        Set myRange = .Content
        With myRange.Find
            .Execute FindText:=from_text, ReplaceWith:=to_text, Replace:=1
        End With
    End With
Next oCell

End Sub

Greetings

Axel

Upvotes: 4

Related Questions