Microsoft Word VBA: replace a character with another character only within certain strings of text

0
votes

In the Microsoft Word VBA editor, I'm trying to write a macro that finds and replaces a certain character with another character only within certain strings of text, not the whole document. For instance, I might want to replace decimal commas with decimal points (not all commas with periods), or a space with a hyphen in certain phrases. A big constraint is that the changes must be tracked via Track Changes, so finding and replacing the whole string of text isn't an option: Some customers think it looks weird and/or sloppy if I replace their numbers with themselves, and they have also worried that some of their data might have gotten changed. (It might also look like I let my computer make edits for me automatically, which I want to avoid.)

I can already do this clunkily by using Selection.Find to find certain strings (or patterns), doing Selection.Collapse, moving the cursor left or right, deleting a comma, and typing a period. I'm hoping there is a faster way to do this, possibly using ranges, but I have had little success finding or replacing anything using Word's Range object. Since I want to run several macros that total well over a hundred possible find-and-replace actions for each document, I'd like to streamline them all as much as possible.

What I've tried so far

For ease of illustration, I'll take the specific examples in which I want to find commas within statistical p-values written as "0,05", "0,01", or "0,001" and change them to periods, but not make this change anywhere else. I'm aware that in real life, searching for those strings could catch numbers in the thousands, millions, etc., but these are just simplified examples for learning/illustration purposes.

(1) The following works fine, it just strikes me as slow when done for many different Find strings in every document.

With Selection.Find
    .ClearFormatting
    .Text = "0,05"
    .MatchWholeWord = True
    .MatchWildcards = False
    .Forward = True
    .Wrap = wdFindContinue
End With
Do While Selection.Find.Execute
    Selection.Collapse
    Selection.MoveRight unit:=wdCharacter, count:=1
    Selection.Delete unit:=wdCharacter, count:=1
    Selection.TypeText (".")
Loop

(2) The most promising other way was adapted from VBA Word: I would like to find a phrase, select the words before it, and italicise the text:

Sub RangeTest()
Dim Rng As Range
Dim Fnd As Boolean

Set Rng = Selection.Range

    With Rng.Find
        .ClearFormatting
        .Execute findText:="0,05", Forward:=True, _
                 format:=False, Wrap:=wdFindContinue
        Fnd = .found
    End With

If Fnd = True Then
        With Rng
            .Find.Wrap = wdFindContinue
            .Find.Text = ","
            .Find.Replacement.Text = "."
            .Find.Execute Replace:=wdReplaceOne
        End With
    End If
End Sub

but it replaces the comma with a period in only the first "0,05" in the document, not all of them.

When I change wdReplaceOne to wdReplaceAll, then every comma in the document gets replaced with a period.

When I try every possible combination of wdFindContinue/wdFindStop (both times) and wdReplaceAll/wdReplaceOne, either one comma gets changed to a period or every one in the document does.

When I change the "If…Then" statement do a "Do While…Loop" statement, Word hangs:

Dim Rng As Range
Dim Fnd As Boolean

Set Rng = Selection.Range

    With Rng.Find
        .ClearFormatting
        .Execute findText:="0,05", Forward:=True, _
                 format:=False, Wrap:=wdFindStop
        Fnd = .found
    End With

    Do While Fnd = True
        With Rng
            .Find.Text = ","
            .Find.Replacement.Text = "."
            .Find.Execute Replace:=wdReplaceAll
        End With
    Loop

Is there any way to loop the "If…Then" statement or get the "Do While…Loop" method to work without hanging?

(3) I tried to adapt the code from this page https://www.techrepublic.com/article/macro-trick-how-to-highlight-multiple-search-strings-in-a-word-document/

Sub WordCollectionTest()

Dim Word As Word.Range
Dim WordCollection(2) As String 
Dim Words As Variant

WordCollection(0) = "0,05"
WordCollection(1) = "0,01"
WordCollection(2) = "0,001"

'This macro behaves weirdly if insertions and deletions aren't hidden (more than one period gets inserted).
With ActiveWindow.view
    .ShowInsertionsAndDeletions = False

For Each Word In ActiveDocument.Words
    For Each Words In WordCollection
        With Selection.Find
        .ClearFormatting
        .Text = Words
        .Forward = True
        .Wrap = wdFindContinue
        .MatchWildcards = False
        .MatchWholeWord = True
    End With
    Do While Selection.Find.Execute
        Selection.Find.Text = ","
        Selection.Find.Replacement.Text = "."
        Selection.Find.Execute Replace:=wdReplaceAll
    Loop
Next
Next

End With
End Sub

but this replaces every comma in the document with a period. (It's also kind of slow.)

(4) I tried putting the Find terms in an array rather than a word collection:

Sub ArrayTest()

Dim vDecimalCommas As Variant
Dim i As Long

vDecimalCommas = Array("0,05", "0,01", "0,001")

'This macro behaves weirdly if insertions and deletions aren't hidden:
With ActiveWindow.view
    .ShowInsertionsAndDeletions = False

For i = LBound(vDecimalCommas) To UBound(vDecimalCommas)
    With Selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = vDecimalCommas(i)
        .Forward = True
        .Wrap = wdFindContinue
        .matchcase = False
        .MatchWholeWord = False
        .MatchWildcards = True
    End With
    Do While Selection.Find.Execute
        Selection.Find.Text = ","
        Selection.Find.Replacement.Text = "."
        Selection.Find.Execute Replace:=wdReplaceAll
    Loop
Next

End With
End Sub

but this only replaces the comma with a period in the second of those numbers that it comes across, oddly enough.

I tried a variant of the Array method:

Sub ArrayTest()
For i = LBound(vDecimalCommas) To UBound(vDecimalCommas)
    With Selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = ","
        .Replacement.Text = "."
        .Forward = True
        .Wrap = wdFindContinue
        .matchcase = False
        .MatchWholeWord = False
        .MatchWildcards = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
Next

End Sub

But this replaces every comma in the document with a period (which isn't surprising, since I don't think the For i statement has any bearing on the Find and Replace commands in this version).

I've tried lots of other variants that I haven't mentioned here. I've tried combining the Array method with the Range/Boolean method. I've tried every variant I know of of the Find, Selection, For i, For Each, If Then, and Do While commands. And every time, only one comma gets replaced with a period or every one does.

Is there some way to define a range that consists of a certain string of text so that word will find and replace commas with periods within that range, every time, and nowhere else? Is there a way to define many such strings in one array or some other kind of list? Or any other way to find and replace commas with periods only within certain strings? I'm far from an expert, so a tiny variation of one of the above methods might work.

1
vbastringreplacems-wordfind
Thanks Timothy, but the problem isn't with the finding, it's with the replacing. (I have become pretty proficient with wildcard searches over the last few months.) – John
Do you know that can use parentheses to break your search expression into groups, then reference those groups in replace? – Timothy Rylatt
Try ([0-9]),([0-9]) in Find and \1.\2 in Replace with – Timothy Rylatt
Yes, for instance, I've learned a lot from this page and this page, but if I delimit groups of text in the Find string with parentheses and refer to them as \1, \2, etc. in the Replace string, then that text gets replaced with itself, which shows up in the tracked changes as deletions and insertions. For instance, the tracked changes would show a 0 being deleted and inserted, a comma being deleted and a period inserted, and a 05 being deleted and inserted. I'm aiming to avoid this. – John
The whole problem is with tracked changes and my need to avoid deleting and inserting unnecessary things, especially numbers. – John

1 Answers

0
votes

Try this:

Sub Tester()

    Dim doc As Document
    
    Set doc = ActiveDocument
    
    'must turn off markup first or you'll end up in a loop...
    If doc.TrackRevisions Then
        doc.Windows(1).View.RevisionsFilter.Markup = wdRevisionsMarkupNone
    End If
    
    Debug.Print ReplaceAll(ActiveDocument, "0,001", ",", ".")
    
    If doc.TrackRevisions Then
        doc.Windows(1).View.RevisionsFilter.Markup = wdRevisionsMarkupAll
    End If

End Sub

Function ReplaceAll(doc As Object, qText As String, _
                   qOld As String, qNew As String) As Long
    Dim rng As Object, pos As Long, n As Long

    Set rng = doc.Range
    ResetFindParameters rng 'reset Find to defaults
    With rng.Find
        .Text = qText
        Do While .Execute
            pos = InStr(rng.Text, qOld)
            Do While pos > 0
                n = n + 1
                rng.Characters(pos).Text = qNew
                pos = InStr(rng.Text, qOld)
            Loop
        Loop
    End With
    ReplaceAll = n
End Function

'reset any Find settings
Sub ResetFindParameters(oRng As Object)
  With oRng.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = ""
    .Replacement.Text = ""
    .Forward = True
    .Wrap = 1 'wdFindContinue
    .Format = False
    .MatchCase = False
    .MatchWholeWord = True '<< adjust following to suit
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
  End With
End Sub