Word macro wildcard issue

[syl3786]

Greetings everyone,



I hope this message finds you well. I was wondering if I could kindly ask for your assistance. I am currently developing a word macro that will find and replace Arabic numbers to Chinese numbers with tracked changes record. If it's not too much trouble, please see the code below:

Sub ANC()

Dim RT As Boolean
   
RT = ActiveDocument.TrackRevisions
ActiveDocument.TrackRevisions = True

Selection.HomeKey Unit:=wdStory, Extend:=wdMove
        
With Selection.Find

        .ClearFormatting
        .Replacement.ClearFormatting
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchWildcards = True
    
        .text = vbTab & "1{1}([!0-9])"
        .Replacement.text = vbTab & "一\1"
        .Replacement.Font.ColorIndex = wdRed
        .Execute Replace:=wdReplaceAll
    
End With
    
ActiveDocument.TrackRevisions = RT

End Sub

For example:

Original paragraph:

[vbTab] 1abc, Video provides a powerful way to help you prove your point. When you 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.

After running the macro:

[vbTab] 一abc, Video provides a powerful way to help you prove your point. When you 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.

I have noticed that the text after "1" is also being changed in wdRed. From what I understand, this is happening because the wildcard "([!0-9])" is occupying a place and when it replaces according to the "\1", it is producing the undesired outcome as mentioned above.

Another issue that I am encountering is that any year, such as "1987" after vbTab, is also being changed to "一987".

If it's not too much trouble, could you please guide me on how to solve the above issues? Your expertise would be greatly appreciated.

Thank you very much for your time and consideration.

[vivka]

Hi! This is the fastest way, otherwise you'll have to work with a range & then move it one char to the left in each loop:

   
    With selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Forward = True
        .Wrap = wdFindStop
        .Format = True
        .MatchWildcards = True
        .text = Chr(9) & "1([!0-9])"
        .Replacement.text = Chr(9) & "-\1"
        .Execute Replace:=wdReplaceAll
        .text = Chr(9) & "-"
        .Replacement.text = ""
        .Replacement.Font.ColorIndex = wdRed
        .Execute Replace:=wdReplaceAll
    End With

Notes: 1) there's no need for {1}; 2) Chr(9) can be used instead of vbTab, which I did; 3) Instead of 'selection.range.Find' you can use 'ActiveDocument.range.Find' & delete 'selection.HomeKey Unit:=wdStory, Extend:=wdMove' making the code shorter; 4) Tracking changes may be faulty (for an unknown reason, at least in my Word 2016), so disabling it can do no harm because the changes will be colored red & visible. Or you can color changes, say, blue if there are red strings in your doc.

[syl3786]

Originally Posted by vivka

Hi! This is the fastest way, otherwise you'll have to work with a range & then move it one char to the left in each loop:

   
    With selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Forward = True
        .Wrap = wdFindStop
        .Format = True
        .MatchWildcards = True
        .text = Chr(9) & "1([!0-9])"
        .Replacement.text = Chr(9) & "-\1"
        .Execute Replace:=wdReplaceAll
        .text = Chr(9) & "-"
        .Replacement.text = ""
        .Replacement.Font.ColorIndex = wdRed
        .Execute Replace:=wdReplaceAll
    End With

Notes: 1) there's no need for {1}; 2) Chr(9) can be used instead of vbTab, which I did; 3) Instead of 'selection.range.Find' you can use 'ActiveDocument.range.Find' & delete 'selection.HomeKey Unit:=wdStory, Extend:=wdMove' making the code shorter; 4) Tracking changes may be faulty (for an unknown reason, at least in my Word 2016), so disabling it can do no harm because the changes will be colored red & visible. Or you can color changes, say, blue if there are red strings in your doc.

Thank you so much for your assistance! Your suggestion was incredibly insightful and I had not considered that approach before. Your intelligence and problem-solving skills are truly impressive!

[syl3786]

Originally Posted by vivka

Hi! This is the fastest way, otherwise you'll have to work with a range & then move it one char to the left in each loop:

   
    With selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Forward = True
        .Wrap = wdFindStop
        .Format = True
        .MatchWildcards = True
        .text = Chr(9) & "1([!0-9])"
        .Replacement.text = Chr(9) & "-\1"
        .Execute Replace:=wdReplaceAll
        .text = Chr(9) & "-"
        .Replacement.text = ""
        .Replacement.Font.ColorIndex = wdRed
        .Execute Replace:=wdReplaceAll
    End With

Notes: 1) there's no need for {1}; 2) Chr(9) can be used instead of vbTab, which I did; 3) Instead of 'selection.range.Find' you can use 'ActiveDocument.range.Find' & delete 'selection.HomeKey Unit:=wdStory, Extend:=wdMove' making the code shorter; 4) Tracking changes may be faulty (for an unknown reason, at least in my Word 2016), so disabling it can do no harm because the changes will be colored red & visible. Or you can color changes, say, blue if there are red strings in your doc.

May I also ask about how to manipulate a range while shifting it one character to the left during each loop?

For example:

Sub test()

   ' 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:\Names.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
        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
            .Wrap = wdFindStop
            .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

This macro utilizes wildcards to replace text based on an Excel file. However, I am unsure how to modify it to shift one character to the left during each loop.

The macro needs to find "ABC (without Member)" (which is ABC[!Member] in wildcard), and replace as ABCMember.

[vivka]

Unfortunately, I rarely work in Excel and I'm not a programmer, so I can suggest a Word code to illustrate using a range:

Sub Replace_Digits_With_Wds()

Dim oRng As range

Application.ScreenUpdating = False
Set oRng = ActiveDocument.range
    With oRng.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Forward = True
        .Wrap = wdFindStop
        .Format = True
        .MatchWildcards = True
        .text = Chr(9) & "1([!0-9])"
        While .Execute
            oRng.End = oRng.End - 1
            oRng = Chr(9) & "-"
            oRng.Font.ColorIndex = wdBrightGreen
            oRng.Collapse wdCollapseEnd
        Wend
Application.ScreenUpdating = True
Set oRng = Nothing
End With

[syl3786]

Originally Posted by vivka

Unfortunately, I rarely work in Excel and I'm not a programmer, so I can suggest a Word code to illustrate using a range:

Sub Replace_Digits_With_Wds()

Dim oRng As range

Application.ScreenUpdating = False
Set oRng = ActiveDocument.range
    With oRng.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Forward = True
        .Wrap = wdFindStop
        .Format = True
        .MatchWildcards = True
        .text = Chr(9) & "1([!0-9])"
        While .Execute
            oRng.End = oRng.End - 1
            oRng = Chr(9) & "-"
            oRng.Font.ColorIndex = wdBrightGreen
            oRng.Collapse wdCollapseEnd
        Wend
Application.ScreenUpdating = True
Set oRng = Nothing
End With

Thank you for sharing your suggestions. While I understand that you may not have extensive experience working with Excel or programming, I appreciate your input and willingness to contribute. I will take your suggestion into consideration and explore the possibility of incorporating a Word code that utilizes a range.

[vivka]

Thank you, syl3786, for your kind words!