Word macro wildcard issue regarding find and replace according to an excel file

[yanlok1345]

Hello everyone,

I hope this message finds you well. I was wondering if I could kindly ask for your assistance. I am currently working on developing a word macro that involves finding and replacing specific text with the help of wildcards based on an excel file. I have managed to create a macro that successfully accomplishes this task:

Code: Select all

Sub FNR_Red()

    ActiveDocument.TrackRevisions = False

    Dim doc As Document
    Dim xlApp As Object
    Dim xlWbk As Object
    Dim xlSht As Object
    Dim rngFind As range
    Dim rngReplace As range
    Dim strFind As String
    Dim strReplace As String
    
    Set doc = ActiveDocument
    Set xlApp = CreateObject("Excel.Application")
    Set xlWbk = xlApp.Workbooks.Open("D:\replace.xlsx")
    Set xlSht = xlWbk.Sheets(1)
    
    ' Loop through each row in the worksheet
    For i = 1 To xlSht.UsedRange.rows.Count
        
        ' Get the find and replace strings from the worksheet
        strFind = xlSht.Cells(i, 1).value
        strReplace = xlSht.Cells(i, 2).value
        
        ' Find and replace the text in the document
        With doc.Content.Find
            .ClearFormatting
            .text = strFind
            .Replacement.ClearFormatting
            .Replacement.text = strReplace
            
            ' Set the font color to red
            .Replacement.Font.Color = wdColorRed
            
            ' Find and replace while preserving the font color
            .Format = True
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = True
            .Execute Replace:=wdReplaceAll, Format:=True
            
        End With
        
    Next i
    
    ' Close the Excel workbook
    xlWbk.Close SaveChanges:=False
    
    ' Quit the Excel application
    xlApp.Quit
    
    ActiveDocument.TrackRevisions = False
    
End Sub

However, here are the issues, for example:

Original paragraph:

Video provides a powerful way to help you prove your point. When 中田英壽 click Online Video, you can paste in the embed code for the video you want to add. You can also type a keyword to search online for the video that best fits your document.

To make your document look professionally produced, Word provides header, footer, cover page, and text box designs that complement each other. For example, you can add a matching cover page, header, and sidebar. Click Insert and then choose the elements you want from the different galleries.

Themes and styles also help keep your document coordinated. When 中田英壽 click Design and choose a new Theme, the pictures, charts, and SmartArt graphics change to match your new theme. When 中田英壽先生 apply styles, your headings change to match the new theme.

After running the macro:

Video provides a powerful way to help you prove your point. When 中田英壽先生 click Online Video, you can paste in the embed code for the video you want to add. You can also type a keyword to search online for the video that best fits your document.

To make your document look professionally produced, Word provides header, footer, cover page, and text box designs that complement each other. For example, you can add a matching cover page, header, and sidebar. Click Insert and then choose the elements you want from the different galleries.

Themes and styles also help keep your document coordinated. When 中田英壽先生 click Design and choose a new Theme, the pictures, charts, and SmartArt graphics change to match your new theme. When 中田英壽先生 apply styles, your headings change to match the new theme.

The text after "中田英壽" will also changed in wdRed. This is the issue due to my wildcard setting in the excel file:

Column A: [<中][田][英][壽>]([!先])
Column B: 中田英壽先生\1
Column C: T
(Column C put a "T" to inform the macro wildcard function should be used.)

What I expect is to only find "中田英壽" and replace as "中田英壽先生". If "中田英壽先生" existed, do not replace it.

May I ask if anyone can kindly assist me in achieving this task? Thank you very much in advance.

(Attached please find the excel template)

[HansV]

Please explain in detail what the issue with the code is.

[yanlok1345]

Please explain in detail what the issue with the code is.

Now this macro replace text according to an excel file.

I want it to move one char to the left in each loop before replacing, therefore the text after the replaced text will not be formatted.

For example, find and replace "ABC" to "ABCMember" in a sentence:

ABC, and other individuals, are always ready and willing to help you.

If I use the following wildcards:

Find: ABC[!Members]
Replace: ABCMembers

the Result:

ABCMembers, and other individuals, are always ready and willing to help you.

In any case, the comma following "ABCMembers" will also be formatted. Do you have any ideas on how to address this issue?

[HansV]

Perhaps like this? It's rather clunky code...

Code: Select all

Sub FNR_Red()
    Dim doc As Document
    Dim xlApp As Object
    Dim xlWbk As Object
    Dim xlSht As Object
    Dim rngFind As Range
    Dim rngReplace As Range
    Dim strFind As String
    Dim strReplace As String
    Dim i As Long
    Dim f As Boolean

    Set doc = ActiveDocument
    doc.TrackRevisions = False

    On Error Resume Next
    Set xlApp = GetObject(Class:="Excel.Application")
    On Error GoTo 0
    If xlApp Is Nothing Then
        Set xlApp = CreateObject(Class:="Excel.Application")
        f = True
    End If
    Set xlWbk = xlApp.Workbooks.Open("D:\replace.xlsx")
    Set xlSht = xlWbk.Sheets(1)

    ' Loop through each row in the worksheet
    For i = 2 To xlSht.UsedRange.Rows.Count

        ' Get the find and replace strings from the worksheet
        strFind = xlSht.Cells(i, 1).Value
        strReplace = xlSht.Cells(i, 2).Value

        Selection.HomeKey Unit:=wdStory
        ' Find and replace the text in the document
        With Selection.Find
            .ClearFormatting
            .Text = strFind
            .Replacement.ClearFormatting
            .Replacement.Text = strReplace
            .Format = True
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = True
            .Execute Replace:=wdReplaceAll
        End With
        Selection.HomeKey Unit:=wdStory
        ' Find and replace the text in the document
        With Selection.Find
            .ClearFormatting
            strReplace = Split(strReplace, "\")(0)
            .Text = strReplace
            .Replacement.Text = strReplace
            ' Set the font color to red
            .Replacement.Font.Color = wdColorRed
            ' Find and replace while preserving the font color
            .Format = True
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = True
            .Execute Replace:=wdReplaceAll
        End With

    Next i

    ' Close the Excel workbook
    xlWbk.Close SaveChanges:=False

    If f Then
        ' Quit the Excel application
        xlApp.Quit
    End If
End Sub

[yanlok1345]

Perhaps like this? It's rather clunky code...

Code: Select all

Sub FNR_Red()
    Dim doc As Document
    Dim xlApp As Object
    Dim xlWbk As Object
    Dim xlSht As Object
    Dim rngFind As Range
    Dim rngReplace As Range
    Dim strFind As String
    Dim strReplace As String
    Dim i As Long
    Dim f As Boolean

    Set doc = ActiveDocument
    doc.TrackRevisions = False

    On Error Resume Next
    Set xlApp = GetObject(Class:="Excel.Application")
    On Error GoTo 0
    If xlApp Is Nothing Then
        Set xlApp = CreateObject(Class:="Excel.Application")
        f = True
    End If
    Set xlWbk = xlApp.Workbooks.Open("D:\replace.xlsx")
    Set xlSht = xlWbk.Sheets(1)

    ' Loop through each row in the worksheet
    For i = 2 To xlSht.UsedRange.Rows.Count

        ' Get the find and replace strings from the worksheet
        strFind = xlSht.Cells(i, 1).Value
        strReplace = xlSht.Cells(i, 2).Value

        Selection.HomeKey Unit:=wdStory
        ' Find and replace the text in the document
        With Selection.Find
            .ClearFormatting
            .Text = strFind
            .Replacement.ClearFormatting
            .Replacement.Text = strReplace
            .Format = True
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = True
            .Execute Replace:=wdReplaceAll
        End With
        Selection.HomeKey Unit:=wdStory
        ' Find and replace the text in the document
        With Selection.Find
            .ClearFormatting
            strReplace = Split(strReplace, "\")(0)
            .Text = strReplace
            .Replacement.Text = strReplace
            ' Set the font color to red
            .Replacement.Font.Color = wdColorRed
            ' Find and replace while preserving the font color
            .Format = True
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = True
            .Execute Replace:=wdReplaceAll
        End With

    Next i

    ' Close the Excel workbook
    xlWbk.Close SaveChanges:=False

    If f Then
        ' Quit the Excel application
        xlApp.Quit
    End If
End Sub

Yes! Although it may not be the most efficient in your perspective (as you are an expert of it), it is incredibly helpful for me. Thank you so much for your assistance! I am truly grateful and words cannot fully express my appreciation.