Macro to run AutoCorrect on existing text

User avatar
Charles Kenyon
4StarLounger
Posts: 596
Joined: 10 Jan 2016, 15:56
Location: Madison, Wisconsin

Macro to run AutoCorrect on existing text

Post by Charles Kenyon »

Note this is a cross-post of sorts. I added onto an existing question with an extension of the question.
The original is here: https://www.msofficeforums.com/word-vba ... macro.html
The macro posted there lets you select text and run AutoCorrect on it, but it only works for a single word/entry. You need to select the text that corresponds to an entry name and then run the macro. That macro is:

Code: Select all

Sub ApplyAutoCorrect()
Dim i As Long
Dim orng As Range
    Set orng = Selection.Range
    orng.MoveStartWhile Chr(32)
    orng.MoveEndWhile Chr(32), wdBackward
    If Len(orng) > 0 Then
        For i = 1 To Word.Application.AutoCorrect.Entries.Count
            If orng.Text = Word.Application.AutoCorrect.Entries(i).Name Then
                Word.Application.AutoCorrect.Entries(i).Apply orng
                Exit For
            End If
        Next i
    End If
lbl_Exit:
    Exit Sub
End Sub
I've tried modifying it, results are curious. In the attached file, it catches the two words at the bottom but not the other ones. This is with all text selected. Moving the ones that work does not change the outcome.

Code: Select all

Sub AutoCorrectNow2()
    ' Graham Mayor Bob Sundquist and Charles Kenyon 2015-12-16
    ' https://www.msofficeforums.com/word-vba/29148-how-replace-wordbasic-autocorrectnow-old-macro.html
    ' Runs autocorrect on selected text as if it were being retyped
    ' Not completed - NOT WORKING
    '
    On Error Resume Next
    Dim oWrd   As range
    Dim Entry  As Object
    Dim iCount As Long, i As Long
    Let iCount = Selection.Words.Count
    For i = 1 To iCount
        Set oWrd = Selection.Words(i)
        For Each Entry In Word.Application.AutoCorrect.Entries
            If oWrd.Text = Entry.Name Then
                Entry.Apply oWrd
                Exit For
            End If
        Next Entry
    Next i
    Set oWrd = Nothing
    Set Entry = Nothing
    On Error GoTo -1
End Sub
You do not have the required permissions to view the files attached to this post.
Last edited by Charles Kenyon on 10 Jun 2022, 22:22, edited 3 times in total.

User avatar
HansV
Administrator
Posts: 78238
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Macro to run AutoCorrect on existing text

Post by HansV »

Are you sure you attache the correct document? The current one contains "No table of contents entries found."
Best wishes,
Hans

User avatar
Charles Kenyon
4StarLounger
Posts: 596
Joined: 10 Jan 2016, 15:56
Location: Madison, Wisconsin

Re: Macro to run AutoCorrect on existing text

Post by Charles Kenyon »

Sorry about that. I have edited. I name lots of files "deleteme" (and later do delete them). I grabbed it from the wrong folder.

User avatar
HansV
Administrator
Posts: 78238
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Macro to run AutoCorrect on existing text

Post by HansV »

Thanks. The problem is Word's definition of a word.
If what we would consider a word is followed by a space, Word's "word" includes that space.
So Word does not consider "comapny" and "warrent" as words, but "comapny " and "warrent ".
The last two words in the document were followed by a comma instead of a space. Word does not include the comma in its version of the words.
Next problem: if we check for an AutoCorrect entry plus a space, the macro does find "comapny ", but then corrects it to "company" without a space. So we have to adjust for that.

Try this version:

Code: Select all

Sub AutoCorrectNow2()
    ' Graham Mayor Bob Sundquist and Charles Kenyon 2015-12-16
    ' https://www.msofficeforums.com/word-vba/29148-how-replace-wordbasic-autocorrectnow-old-macro.html
    ' Runs autocorrect on selected text as if it were being retyped
    ' Not completed - NOT WORKING
    '
    Dim oWrd   As Range
    Dim Entry  As Object
    Dim iCount As Long, i As Long
    On Error Resume Next
    Let iCount = Selection.Words.Count
    For i = 1 To iCount
        Set oWrd = Selection.Words(i)
        For Each Entry In Word.Application.AutoCorrect.Entries
            If oWrd.Text = Entry.Name Then
                oWrd.Text = Entry.Value
                Exit For
            ElseIf oWrd.Text = Entry.Name & " " Then
                oWrd.Text = Entry.Value & " "
                Exit For
            End If
        Next Entry
    Next i
    Set oWrd = Nothing
    Set Entry = Nothing
End Sub
Best wishes,
Hans

User avatar
Charles Kenyon
4StarLounger
Posts: 596
Joined: 10 Jan 2016, 15:56
Location: Madison, Wisconsin

Re: Macro to run AutoCorrect on existing text

Post by Charles Kenyon »

(EDIT: I did not see your response. It works a charm in my sample! It does not work on the table from Jay's utility.)
Here is an updated one as well as one created using Jay Freedman's AutoCorrect2007 utility that has lots of entries in a table. When run on the table, only the first entry is changed. When run on the ordinary text, the items that are interspersed in a paragraph with other text are not reached but those on their own line or in the line where each of the terms is a problem are changed. This likely has to do with how vba measures a word.

The ones in the table created by Jay's macro only replace the first one. The table in my other document replaces all of them except the one in a sentence!. What you've given me is a huge step up and may be enough.
:scratch:
You do not have the required permissions to view the files attached to this post.

User avatar
Charles Kenyon
4StarLounger
Posts: 596
Joined: 10 Jan 2016, 15:56
Location: Madison, Wisconsin

Re: Macro to run AutoCorrect on existing text

Post by Charles Kenyon »

The following macro was posted by "Independent Advisor" reanvillareal.
It is slow and does the entire document rather than a selection. It handles multi-word entries and most of the entries in the AutoCorrect backup document (not the fractions).

Code: Select all

Sub AutoCorrectBruteReplace()
    ' https://answers.microsoft.com/en-us/msoffice/forum/all/macro-for-autocorrect/91f9bdb1-47ac-4cec-9842-5f1ee38bd7cf?page=1
    ' rianvillareal 2022-06-11
    ' This does the whole document, not the selection. It is slow. Handles multi-word entries.
    Dim oEntry   As Word.AutoCorrectEntry
    For Each oEntry In AutoCorrect.Entries
        With Selection.Find
            .ClearFormatting
            .Replacement.ClearFormatting
            .Text = oEntry.Name
            .Replacement.Text = oEntry.Value
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = True
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
            .Execute Replace:=wdReplaceAll
        End With
    Next
    Set oEntry = Nothing
End Sub
I tried adapting it to use a range and to only apply to selected text, without any noticeable difference.

Code: Select all

Sub AutoCorrectBruteReplace2()
    ' https://answers.microsoft.com/en-us/msoffice/forum/all/macro-for-autocorrect/91f9bdb1-47ac-4cec-9842-5f1ee38bd7cf?page=1
    ' rianvillareal 2022-06-11 modified by Charles Kenyon to use range and work with selected text
    ' It is slow. Handles multi-word entries. Does not handle fractions
    ' Does Not Work any differently than original AFAIK
    '
    Dim oEntry As Word.AutoCorrectEntry
    Dim oRng   As range
    Set oRng = Selection.range
    For Each oEntry In AutoCorrect.Entries
        With oRng.Find
            .ClearFormatting
            .Replacement.ClearFormatting
            .Text = oEntry.Name
            .Replacement.Text = oEntry.Value
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = True
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
            .Execute Replace:=wdReplaceAll
        End With
    Next
End Sub
These are posted for information only. I do not expect to be working more on this but will follow any comments/ideas.

User avatar
HansV
Administrator
Posts: 78238
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Macro to run AutoCorrect on existing text

Post by HansV »

If you want to limit it to the selected range, try changing

Code: Select all

            .Wrap = wdFindContinue
to

Code: Select all

            .Wrap = wdFindStop
Best wishes,
Hans

User avatar
Charles Kenyon
4StarLounger
Posts: 596
Joined: 10 Jan 2016, 15:56
Location: Madison, Wisconsin

Re: Macro to run AutoCorrect on existing text

Post by Charles Kenyon »

Thank you so much. That works.
I took the liberty of posting the corrected macro on the MS community and the Word Office Forum.
https://answers.microsoft.com/en-us/mso ... 1ee38bd7cf
https://www.msofficeforums.com/word-vba ... macro.html

Code: Select all

  Sub AutoCorrectBruteReplace2()
      ' https://answers.microsoft.com/en-us/msoffice/forum/all/macro-for-autocorrect/91f9bdb1-47ac-4cec-9842-5f1ee38bd7cf?page=1
      ' rianvillareal 2022-06-11 modified by Charles Kenyon with help by Hans Vogelar to use range and work with selected text
      ' It is slow. Handles multi-word entries. Does not handle fractions
      ' If text is selected, it operates only on selected text
      '       If nothing selected, it operates on entire document
      '
      Dim oEntry As Word.AutoCorrectEntry
      Dim oRng   As range
      Set oRng = Selection.range
      For Each oEntry In AutoCorrect.Entries
          With oRng.Find
              .ClearFormatting
              .Replacement.ClearFormatting
              .Text = oEntry.Name
              .Replacement.Text = oEntry.Value
              .Forward = True
              .Wrap = wdFindStop
              .Format = False
              .MatchCase = False
              .MatchWholeWord = True
              .MatchWildcards = False
              .MatchSoundsLike = False
              .MatchAllWordForms = False
              .Execute Replace:=wdReplaceAll
          End With
      Next
  End Sub

User avatar
HansV
Administrator
Posts: 78238
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Macro to run AutoCorrect on existing text

Post by HansV »

I have moved some posts from this topic to a new one: Selecting a word in Word.
Best wishes,
Hans

User avatar
Charles Kenyon
4StarLounger
Posts: 596
Joined: 10 Jan 2016, 15:56
Location: Madison, Wisconsin

Re: Macro to run AutoCorrect on existing text

Post by Charles Kenyon »

:clapping: Thank you.