Empty paragraphs between tables

[Greg Maxey]

Dave Rado has an article on the MVP FAG page for removing empty paragraphs.
http://word.mvps.org/FAQs/MacrosVBA/DeleteEmptyParas.htm

In that article he explains that the code:

Find: ^13{2,}
Replace with: ^p

Will find and replace empty paragraphs. It will.

He goes on to say that you can't use that code to replace the PM immediately
preceding or following a table. Again he is correct it won't.

Here is the problem:

- Open a new document enter say ten empty paragraphs then a table. Use the
code above and only "1" those ten paragraphs will be removed!!

- Open a new document and enter a table followed by say ten empty
paragraphs. Use the code above and all but "2" of those paragraphs will be
removed.

Dave offers a VBA solution for removing the empty paragraphs immediately
before and after a table. His method works, but again in the first example
above you will still have 8 empty paragraphs remaining!:

Dim oTable As Table, MyRange As Range

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

I have modified Dave's code to remove all empty paragraphs preceeding or
following a table:

Sub Tables()
Dim oTable As Table
Dim MyRange As Range
Dim emptyPara As Boolean

For Each oTable In ActiveDocument.Tables
#If VBA6 Then
'For Word 2000 and higher for speed
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
Do
MyRange.Collapse wdCollapseStart
MyRange.Move wdParagraph, -1
'if para before table empty, delete it
If MyRange.Paragraphs(1).Range.Text = vbCr Then
emptyPara = True
MyRange.Paragraphs(1).Range.Delete
Else
emptyPara = False
End If
Loop While emptyPara = True
Next oTable
End Sub

Does anyone know why the basic find and replace method doesn't work for
empty PMs preceeding a table?

Thanks

 

[Greg Maxey]

Dave also mentions that removing the empty PM separating two tables will
result in the tables being joined. Here is some code that I think will be
useful for that situation:

Sub RemoveEmptyPMsNearTables()
'Removes the empty PM after a table and all empty PMs
'before a table
Dim oTable As Table
Dim MyRange As Range
Dim emptyPara As Boolean

For Each oTable In ActiveDocument.Tables
#If VBA6 Then
'For Word 2000 and higher for speed
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.Collapse wdCollapseEnd
MyRange.Move wdParagraph, 1
If MyRange.Information(wdWithInTable) Then
'Do nothing
Else
MyRange.Move wdParagraph, -1
MyRange.Paragraphs(1).Range.Delete
End If
End If
'Set a range to the para preceding the current table
Set MyRange = oTable.Range
Do
MyRange.Collapse wdCollapseStart
MyRange.Move wdParagraph, -1
'if para before table empty, delete it
If MyRange.Paragraphs(1).Range.Text = vbCr Then
MyRange.Collapse wdCollapseStart
If MyRange.Start = ActiveDocument.StoryRanges(wdMainTextStory).Start
Then
MyRange.Paragraphs(1).Range.Delete
Else
MyRange.Move wdParagraph, -1
If MyRange.Information(wdWithInTable) Then
If MsgBox("You have two tables separatated" _
& " by a single empty paragraph" _
& " mark. Do you want to delete" _
& " the empty paragraph and merge" _
& " the two tables?", vbYesNo) = vbYes Then
MyRange.Move wdParagraph, 1
emptyPara = True
MyRange.Paragraphs(1).Range.Delete
End If
Else
MyRange.Move wdParagraph, 1
emptyPara = True
MyRange.Paragraphs(1).Range.Delete
End If
End If
Else
emptyPara = False
End If
Loop While emptyPara = True
Next oTable
End Sub