View Single Post
 
Old 04-28-2014, 05:15 PM
jsuebersax jsuebersax is offline Windows 7 32bit Office 2013
Novice
 
Join Date: Apr 2014
Posts: 3
jsuebersax is on a distinguished road
Default Macro to automatically replace large number of words

This is a followup to a post I made in the Word forum. I was having a problem getting the Word spell-checker to work properly in a document with a huge number of spelling errors. The issue is that if you select "Change All" in the Word spell-checker, it changes the current instance immediately, but it doesn't change later instances until the spell-checking process gets to that part of the document. Hence if you terminate the spell-checker before completing the entire document, later instances of the previously corrected word will not be corrected. (At least that's what seems to be the case.)

This macro solves the problem by bypassing the spell-checker, instead repeatedly calling the Replace function, and working with a user-supplied list of incorrectly and correctly spelled words.

This works best when you know pretty much in advance what misspellings to expect. For example, I'm using it to modernize a document written in Elizabethan English.
Code:
Sub ReplaceStrings() 
     '
     ' ReplaceStrings Macro - Replace all instances of each of a set of target
     ' (misspelled) words with correctly spelled words. A text file suppies target
     ' and replacement words (one pair per line separated by a comma), i.e.:
     '
     ' oldword, newword
     ' Note: manually set upper bound to number of word pairs
    Dim OldWord(1 To 328) As String 
    Dim NewWord(1 To 328) As String 
     ' Note: supply path and file name for word pair list
    Open "c:/work/list.txt" For Input As #1 
    For I = 1 To UBound(OldWord) 
        Input #1, OldWord(I), NewWord(I) 
        Selection.Find.Execute Replace:=wdReplaceAll 
        With Selection.Find 
            .Text = OldWord(I) 
            .Replacement.Text = NewWord(I) 
            .Forward = True 
            .Wrap = wdFindContinue 
            .Format = False 
            .MatchCase = False 
            .MatchWholeWord = True 
            .MatchWildcards = False 
            .MatchSoundsLike = False 
            .MatchAllWordForms = False 
        End With 
        Selection.Find.Execute Replace:=wdReplaceAll 
    Next I 
    Close (1) 
End Sub

Last edited by macropod; 04-29-2014 at 03:14 AM. Reason: Added code tags & formatting
Reply With Quote