Find list of words and replace

nonno · #1 09-24-2024, 04:16 PM

From everything I've found on-line, this seems like it should work, but it fails to replace all occurrences. Can you see what I might be missing?

Code:

Sub MultiReplace2()
    Dim StrFind As String
    Dim StrRepl As String
    Dim i As Long
    StrFind = "-Ge,-Ex,-Le,-Nu,-De,-Jo,-Ju,-Ru,-1Sa,-2Sa,-1Ki,-2Ki,-1Ch,-2Ch,-Ez,-Ne,-Es,-Jo,-Ps,-Pr,-Ec,-So,-Is,-Je,-La,-Ez,-Da,-Ho,-Jo,-Am,-Ob,-Jo,-Mi,-Na,-Ha,-Ze,-Ha,-Ze,-Ma,-Mt,-Mk,-Lk,-Jn,-Ac,-Ro,-1Co,-2Co,-Ga,-Ep,-Ph,-Co,-1Th,-2Th,-1Ti,-2Ti,-Ti,-Ph,-He,-Ja,-1Pe,-2Pe,-1Jn,-2Jn,-3Jn,-Ju,-Re"
    StrRepl = "- Genesis,- Exodus,- Leviticus,- Numbers,- Deuteronomy,- Joshua,- Judges,- Ruth,- 1 Samuel,- 2 Samuel,- 1 Kings,- 2 Kings,- 1 Chronicles,- 2 Chronicles,- Ezra,- Nehemiah,- Esther,- Job,- Psalm,- Proverbs,- Ecclesiastes,- Song of Solomon,- Isaiah,- Jeremiah,- Lamentations,- Ezekiel,- Daniel,- Hosea,- Joel,- Amos,- Obadiah,- Jonah,- Micah,- Nahum,- Habakkuk,- Zephaniah,- Haggai,- Zechariah,- Malachi,- Matthew,- Mark,- Luke,- John,- Acts,- Romans,- 1 Corinthians,- 2 Corinthians,- Galatians,- Ephesians,- Philippians,- Colossians,- 1 Thessalonians,- 2 Thessalonians,- 1 Timothy,- 2 Timothy,- Titus,- Philemon,- Hebrews,- James,- 1 Peter,- 2 Peter,- 1 John,- 2 John,- 3 John,- Jude,- Revelation"
    For i = 0 To UBound(Split(StrFind, ","))
        ActiveDocument.Content.Select
        With Selection.Find
            .ClearFormatting
            .Replacement.ClearFormatting
            .Text = Split(StrFind, ",")(i)
            .Replacement.Text = Split(StrRepl, ",")(i)
            .Format = False
            .MatchWholeWord = True
            .Execute Replace:=wdReplaceAll
        End With
    Next i
    Selection.HomeKey wdStory
End Sub

Guessed · #2 09-24-2024, 06:24 PM

Your selection.find is potentially missing a few lines which could be critical. The first two that spring to mind which might be relevant are:
.Wrap = ??
.MatchCase = ??

You also aren't searching the header/footer storyranges so that is another area that your instances are likely to be sitting.

macropod · #3 09-24-2024, 07:53 PM

Far more efficient:

Code:

Sub MultiReplace2()
Application.ScreenUpdating = False
    Dim StrFind As String, StrRepl As String, i As Long
    StrFind = "-Ge,-Ex,-Le,-Nu,-De,-Jo,-Ju,-Ru,-1Sa,-2Sa,-1Ki,-2Ki,-1Ch,-2Ch,-Ez,-Ne,-Es,-Jo,-Ps,-Pr,-Ec,-So,-Is,-Je,-La,-Ez,-Da,-Ho,-Jo,-Am,-Ob,-Jo,-Mi,-Na,-Ha,-Ze,-Ha,-Ze,-Ma,-Mt,-Mk,-Lk,-Jn,-Ac,-Ro,-1Co,-2Co,-Ga,-Ep,-Ph,-Co,-1Th,-2Th,-1Ti,-2Ti,-Ti,-Ph,-He,-Ja,-1Pe,-2Pe,-1Jn,-2Jn,-3Jn,-Ju,-Re"
    StrRepl = "- Genesis,- Exodus,- Leviticus,- Numbers,- Deuteronomy,- Joshua,- Judges,- Ruth,- 1 Samuel,- 2 Samuel,- 1 Kings,- 2 Kings,- 1 Chronicles,- 2 Chronicles,- Ezra,- Nehemiah,- Esther,- Job,- Psalm,- Proverbs,- Ecclesiastes,- Song of Solomon,- Isaiah,- Jeremiah,- Lamentations,- Ezekiel,- Daniel,- Hosea,- Joel,- Amos,- Obadiah,- Jonah,- Micah,- Nahum,- Habakkuk,- Zephaniah,- Haggai,- Zechariah,- Malachi,- Matthew,- Mark,- Luke,- John,- Acts,- Romans,- 1 Corinthians,- 2 Corinthians,- Galatians,- Ephesians,- Philippians,- Colossians,- 1 Thessalonians,- 2 Thessalonians,- 1 Timothy,- 2 Timothy,- Titus,- Philemon,- Hebrews,- James,- 1 Peter,- 2 Peter,- 1 John,- 2 John,- 3 John,- Jude,- Revelation"
    With ActiveDocument.Range.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Format = False
        .MatchWholeWord = True
        .Wrap = wdFindContinue
        For i = 0 To UBound(Split(StrFind, ","))
            .Text = Split(StrFind, ",")(i)
            .Replacement.Text = Split(StrRepl, ",")(i)
            .Execute Replace:=wdReplaceAll
        Next i
    End With
Application.ScreenUpdating = True
End Sub

and it doesn't change your cursor location in the document.

nonno · #4 10-07-2024, 03:49 PM

Sorry for the delay, I was out of town. Thank you for these suggestions. They all worked wonderful.

Thread Tools
Show Printable Version Email this Page
Display Modes
Linear Mode Switch to Hybrid Mode Switch to Threaded Mode

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Office 2021: How to use the “Find and Replace” tool to replace searched words with other words with	Jamal NUMAN	Word	7	08-20-2024 11:13 PM
Find and Replace from Predetermined list of Text for Both Find and Replace	dminor	Word VBA	1	08-16-2022 03:40 PM
Find and replace words according to excel file	laith93	Word VBA	7	12-13-2021 08:11 PM
Find & Replace Multiple words	Gartholameau	Word VBA	2	01-20-2019 04:56 PM
How to find (highlight) two and more words in a list of 75k single words in Word 2010	Usora	Word	8	05-29-2018 03:34 AM