Keeping a macro from going beyond selection

Ulodesk · #1 02-23-2022, 12:45 PM

A session with the boss today stipulated certain optional space-saving formatting, which I am trying to put into a macro. The attached sample doc illustrates an original format and intended result.

Here's my recorded macro, which applies itself to the end of the document rather than stopping with the selection, highlighted here for clarity.

The lack of close parenthesis after the date format is simply something I don't know how to specify.

Code:

Sub BulletsToPara()
'
' BulletsToPara Macro
'
'
    Selection.Style = ActiveDocument.Styles("N-BodyText,n-bd")
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^t"
        .Replacement.Text = " ("
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "^13"
        .Replacement.Text = ". "
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "(..)"
        .Replacement.Text = "."
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = ". . "
        .Replacement.Text = ". "
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = ".."
        .Replacement.Text = "."
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Macro to auto add upon selection	paulie102003	Excel Programming	2	01-04-2018 01:10 AM
How to trigger a macro on cell selection	Larry_1	Excel Programming	6	12-24-2017 11:09 AM
Mail Merge keeping VBA Macro	Piney	Word VBA	5	08-03-2015 04:12 PM
Limiting a macro to a selection	Ulodesk	Word VBA	4	06-19-2012 06:09 AM
Printing a Selection in Word and keeping it in the same place on the page	punkrae	Word	0	03-29-2012 10:49 AM