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.

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