Link to home
Start Free TrialLog in
Avatar of Mike
MikeFlag for United Kingdom of Great Britain and Northern Ireland

asked on

MS Word VBA to Remove Redundant Blank Paragraph Spacing

I'm looking for an MS Word VBA macro to remove redundant blank paragraphs spacing from Word documents.  There are many examples of snippets which replace ^p^p with ^p and loop to catch ^p^p....^p such as GrahamSkan's answer to Q 23519746. When run these have the effect of making all paragraphs in a document contiguous i.e. there are no gaps between them.

Instead, I would like that where any two text-containing paragraphs were previously separated by one or more blank paragraphs then following the macro being run each such pair should be separated by only one blank paragraph. In other words, paragraphs that were previously separated from each other should remain separated but that separation should where necessary be contracted.

Any suggestions gratefully received.
Avatar of GrahamSkan
GrahamSkan
Flag of United Kingdom of Great Britain and Northern Ireland image

Fiu can do that with a simple Wildcard Find and Replace

Find what:  [^13]{2,}
Options: Use Wildcards

Replace with: ^p
ASKER CERTIFIED SOLUTION
Avatar of GrahamSkan
GrahamSkan
Flag of United Kingdom of Great Britain and Northern Ireland image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of Mike

ASKER

Thanks Graham. This makes all the paragraphs contiguous with each other, whereas I wanted paragraphs that originally had 'gaps' between them to have those gaps contracted to one blank paragraph. I modified the code slightly to look for 3 para marks and replace by 2 para marks and that seems to work fine, and fast. So thanks!
 
Sub RemoveBlankParagraphs()
    With ActiveDocument.Range.Find
        .Text = "[^13]{3,}"  '^p not understood in Wildcard find, so use ^13 instead
        .MatchWildcards = True
        .Replacement.Text = "^p^p"
        .Execute Replace:=wdReplaceAll
    End With
End Sub

Open in new window