Word macro wildcard issue regarding changing specific text color to wdRed according to an excel file

[yanlok1345]

Hello everyone,

I am currently working on developing a word macro that involves changing specific text color to wdRed with the help of wildcards based on an excel file. I have managed to create a macro that successfully highlight specific text based on an excel file:

Code: Select all

Sub HighlightText()

    Dim excelFilePath As String
    Dim ExcelApp As Object
    Dim ExcelWorkbook As Object
    Dim ExcelWorksheet As Object
    Dim wordDoc As Document
    Dim findRange As range
    Dim findText As String
    Dim wildcardFlag As String
    
    excelFilePath = "D:\Database.xlsx"
    
    ' Create an instance of Excel and open the workbook
    Set ExcelApp = CreateObject("Excel.Application")
    Set ExcelWorkbook = ExcelApp.Workbooks.Open(excelFilePath)
    
    ' Set the worksheet to be used
    Set ExcelWorksheet = ExcelWorkbook.Sheets(2)
    
    ' Set the Word document to be used
    Set wordDoc = ActiveDocument
    
    ' Loop through the rows in the Excel file
    For i = 2 To ExcelWorksheet.Cells(ExcelWorksheet.rows.Count, 1).End(-4162).Row ' -4162 represents xlUp
        
        ' Get the text to find from Column A
        findText = ExcelWorksheet.Cells(i, 1).value
        
        ' Get the wildcard flag from Column B
        wildcardFlag = ExcelWorksheet.Cells(i, 2).value
        
        ' Find the text in the Word document
        Set findRange = wordDoc.range
        
        With findRange.Find
            .ClearFormatting
            .text = findText
            
            ' Use wildcard if the flag is "T"
            If wildcardFlag = "T" Then
                .MatchWildcards = True
            End If
            
            ' Highlight the found text with yellow color
            Do While .Execute
                findRange.HighlightColorIndex = wdYellow
                findRange.Collapse wdCollapseEnd
            Loop
        End With
    Next i
    
    ' Close the Excel workbook and quit Excel
    ExcelWorkbook.Close
    ExcelApp.Quit
    
    ' Clean up the objects
    Set ExcelWorksheet = Nothing
    Set ExcelWorkbook = Nothing
    Set ExcelApp = Nothing
    Set findRange = Nothing
    Set wordDoc = Nothing

End Sub

However, here are the issues, for example:

For example, Highlight "ABC" in a sentence:

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

If I use the following wildcards:

Find: ABC[!Members]

the Result:

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

In any case, the comma following "ABC" will also be highlighted.

What I expect is to edit this macro so that it change specific text font color to wdRed, but not highlight them in wdYellow, and also resolve the above issue raised.

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

Here are documents and Excel file for your further action:

Reference.xlsx

original document.docx

Expected result.docx

[HansV]

Does it help if you change

Code: Select all

            Do While .Execute
                findRange.HighlightColorIndex = wdYellow
                findRange.Collapse wdCollapseEnd
            Loop

to

Code: Select all

            Do While .Execute
                findRange.End = findRange.Start + InStr(findText, "[") - 1
                findRange.Font.ColorIndex = wdRed
                findRange.HighlightColorIndex = wdYellow
                findRange.Collapse wdCollapseEnd
            Loop

[snb]

I'd prefer you to upload a Word sample file.

[yanlok1345]

Does it help if you change

Code: Select all

            Do While .Execute
                findRange.HighlightColorIndex = wdYellow
                findRange.Collapse wdCollapseEnd
            Loop

to

Code: Select all

            Do While .Execute
                findRange.End = findRange.Start + InStr(findText, "[") - 1
                findRange.Font.ColorIndex = wdRed
                findRange.HighlightColorIndex = wdYellow
                findRange.Collapse wdCollapseEnd
            Loop

Yes! This is what i expected! Thank you very much for your assistance!

Additionally, I was wondering if you could modify the following macro so that it can perform a similar task like the highlighted one.

For example, Replace "ABC" 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\1

the Result:

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

In any case, the comma following "ABC" will also be formatted in red font color.

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

I apologize for asking an excessive number of questions here.

Code: Select all

Sub FindandReplace()
    ActiveDocument.TrackRevisions = False
    
    ' Declare variables
    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 the document object
    Set doc = ActiveDocument
    
    ' Open the Excel workbook
    Set xlApp = CreateObject("Excel.Application")
    Set xlWbk = xlApp.Workbooks.Open("C:\N.xlsx")
    
    ' Set the worksheet object
    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
        Set rngFind = doc.Content
        With rngFind.Find
            .ClearFormatting
            .text = strFind
            .Replacement.ClearFormatting
            .Replacement.text = strReplace
            
            ' Set the font color to red
            .Replacement.Font.ColorIndex = wdRed
            
            ' Find and replace while preserving the font color
            .Format = True
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = True
            .Execute Replace:=wdReplaceAll, Format:=True
            
        End With
        
        ' Adjust the range to exclude the last character
        Set rngFind = doc.Content
        rngFind.End = rngFind.End - 1
        
    Next i
    
    ' Close the Excel workbook
    xlWbk.Close SaveChanges:=False
    
    ' Quit the Excel application
    xlApp.Quit
    
    ActiveDocument.TrackRevisions = False
    
End Sub

[yanlok1345]

I'd prefer you to upload a Word sample file.

Thanks for your reply. I will edit the post and upload it.

[HansV]

You cannot do that in one step. Either use code like higher up in this thread, or like the code that I posted in an earlier thread.

[yanlok1345]

You cannot do that in one step. Either use code like higher up in this thread, or like the code that I posted in an earlier thread.

Thank you very much for your assistance.

Certainly. Currently, I am utilizing a highlight macro to highlight specific text by changing its font color to red. Then, I am utilizing another macro to find and replace only the text with the wdred color. Finally, I am using a macro to change the font color from red to black with track changes. While this process may seem a bit cumbersome, it has been effective for my needs and I have not explored alternative options further. As the saying goes, the end justifies the means.

[yanlok1345]

I'd prefer you to upload a Word sample file.

I just uploaded the documents and excel file for you. Thanks for your help!