Need a Macro that Combines Every 5 sentences into a paragraph

macropod · #16 01-11-2012, 09:59 AM

Hi jgarland,

In that case, try a wildcard Find/Replace where:
Find = (*)^13(*)^13(*)^13(*)^13(*^13)
Replace = \1 \2 \3 \4 \5

jgarland · #17 01-11-2012, 10:06 AM

Perfect. Now is there an easy way to make a macro out of this so I can just do an Alt-8 and run it in two clicks?

macropod · #18 01-11-2012, 10:09 AM

Hi jgarland,

yes, but which of these various Find/Replace operations do you need (and in which order)? More than one can be incorporated into the same macro.

jgarland · #19 01-11-2012, 10:15 AM

Just the one you mentioned:

In that case, try a wildcard Find/Replace where:
Find = (*)^13(*)^13(*)^13(*)^13(*^13)
Replace = \1 \2 \3 \4 \5

jgarland · #20 01-11-2012, 10:22 AM

And actually, is there a way to only apply the macro to all the groups of sentences except the first group? The first group is the title of the article, and the rest of the groups are the article's body.

jgarland · #21 01-11-2012, 10:25 AM

Sorry, one more thing: can there be a rule that if there is less than 5 groups of sentences (for example at the end of the article, after the initial macro would be run) then merge the remaining sentence groups together?

macropod · #22 01-11-2012, 11:01 AM

Hi jgarland,

There was some serious scope creep in those last two posts - especially the last one. Try:

Code:

Sub ParaMerge()
Application.ScreenUpdating = False
Dim Rng As Range
With ActiveDocument
  Set Rng = .Range
  Rng.Start = .Range.Paragraphs(2).Range.Start
  With Rng
    With .Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Text = "(*)^13(*)^13(*)^13(*)^13(*^13)"
      .Replacement.Text = "\1 \2 \3 \4 \5"
      .Forward = True
      .Wrap = wdFindContinue
      .Format = False
      .MatchWildcards = True
      .Execute Replace:=wdReplaceAll
    End With
    If .Sentences.Count > 20 Then
      Do
        With .Paragraphs.Last.Previous.Range
          If .Sentences.Count < 20 Then
            .Characters.Last.Delete
            .InsertAfter " "
          Else
            Exit Do
          End If
        End With
      Loop
    Else
      With .Find
        .Text = "^13"
        .Replacement.Text = " "
      .Execute Replace:=wdReplaceAll
      End With
    End If
  End With
End With
Application.ScreenUpdating = True
End Sub

jgarland · #23 01-11-2012, 11:19 AM

Awesome, it works perfectly. Thank you!!

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
problem with MS word merging words and sentences	aretai	Word	5	07-17-2018 12:32 AM
Exceptions for 'Capitalize first letter of sentences'	gazpacho	Word	1	01-12-2012 11:43 AM
How to filter sentences wth highlighted colour	rajpes	Word	4	02-25-2011 12:43 AM
keep only sentences beginning with: Wind	Michael007	Word VBA	3	01-17-2011 04:11 PM
capitalize first letter of sentences	norco1	Word	0	06-25-2006 12:37 PM