CODEWITHSUNDEEP
vbams-word
Alex
Alex

Reputation: 13

MS Word macro to delete all empty paragraphs leaving sections interruptions

I'm written this macro in MS Word to remove all empty paragraphs. It works well but, if document contains more than one section, the macro deletes the interruption and merges all sections into one.

Dim i As Long
With ActiveDocument.Range
    For i = .Paragraphs.Count To 1 Step -1
        If Len(.Paragraphs(i).Range.Text) = 1 Then
            .Paragraphs(i).Range.Delete
        End If
    Next i
End With

How can I solve this?

Upvotes: 0

Views: 590

Answers (2)

macropod
macropod

Reputation: 13490

Unless your document has tables preceded by empty paragraphs, you don't even need VBA for this! All you need is a wildcard Find/Replace, where:

Find = [^13]{2,}
Replace = ^p

Of course, this could be incorporated into a macro, with code like:

With ActiveDocument.Range.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "[^13]{2,}"
    .Replacement.Text = "^p"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = False 
    .MatchWildcards = True
    .Execute Replace:=wdReplaceAll
End With

In case you do have tables preceded by empty paragraphs, see:

https://www.msofficeforums.com/167142-post9.html

Upvotes: 0

Charles Kenyon
Charles Kenyon

Reputation: 1026

Use Replace

Sub ReplaceEmptyParagraphs()
    ' https://wordmvp.com/FAQs/MacrosVBA/DeleteEmptyParas.htm by Word MVP Dave Rado
    ' this procedure compiled from above by Charles Kenyon 6/29/2021
    '   IN GENERAL - EMPTY PARAGRAPHS
    With Selection.Find
        .Text = "^13{2,}"
        .Replacement.Text = "^p"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
        .Execute Replace:=wdReplaceAll
    End With

    '   FIRST AND LAST EMPTY PARAGRAPHS
    Dim MyRange As range
    Set MyRange = ActiveDocument.Paragraphs(1).range
    If MyRange.Text = vbCr Then MyRange.Delete

    Set MyRange = ActiveDocument.Paragraphs.Last.range
    If MyRange.Text = vbCr Then MyRange.Delete

    '   BEFORE AND AFTER TABLES
    Dim oTable As Table

    For Each oTable In ActiveDocument.Tables
        #If VBA6 Then
            'The following is only compiled and run if Word 2000 or 2002 is in use
            'It speeds up the table and your code
            oTable.AllowAutoFit = False
        #End If

        'Set a range to the para following the current table
        Set MyRange = oTable.range
        MyRange.Collapse wdCollapseEnd
        'if para after table empty, delete it
        If MyRange.Paragraphs(1).range.Text = vbCr Then
            MyRange.Paragraphs(1).range.Delete
        End If

        'Set a range to the para preceding the current table
        Set MyRange = oTable.range
        MyRange.Collapse wdCollapseStart
        MyRange.Move wdParagraph, -1
        'if para before table empty, delete it
        If MyRange.Paragraphs(1).range.Text = vbCr Then
            MyRange.Paragraphs(1).range.Delete
        End If
    Next oTable
    Set MyRange = Nothing
    Set oTable = Nothing
End Sub

See Remove all empty paragraphs from a document by Word MVP Dave Rado. See the full article.

You can remove most empty paragraphs from a document by doing a wildcard Find & Replace.

Upvotes: 1

Related Questions