Remove empty paragraphs

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

In converting web pages to word docs I get a lot of empty paragraphs. I'd
like to delete them quickly. What is the best way?

I tried the "find" (^13){1,}, "replace with" \1 . That didn't work for me.
 
Fred,

See:
http://word.mvps.org/FAQs/Formatting/CleanWebText.htm


I use this macro to clean up web text:

Sub CleanUpText()

Dim EP As Paragraph
Dim Response1 As Long
Dim Response2 As Long
Dim Response3 As Long
Dim Response4 As String

Response3 = MsgBox("Do you want to remove leading spaces or characters?",
vbYesNo)
If Response3 = vbYes Then
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^l {1,}"
.Replacement.Text = "^l"
.Forward = True
.Wrap = wdFindContinue
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "^l[\>]{1,}"
.Replacement.Text = "^l"
.Forward = True
.Wrap = wdFindContinue
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "^13[\>]{1,}"
.Replacement.Text = "^p"
.Forward = True
.Wrap = wdFindContinue
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^13 {1,}"
.Replacement.Text = "^p"
.Forward = True
.Wrap = wdFindContinue
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "^l {1,}"
.Replacement.Text = "^l"
.Forward = True
.Wrap = wdFindContinue
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
Response4 = InputBox("Type in any additional leading character")

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = Response4
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.MatchWildcards = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End If
Response2 = MsgBox("Do you want to replace linebreaks with paragraph
fromatting?", vbYesNo)
If Response2 = vbYes Then
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^l{2,}"
.Replacement.Text = "^p"
.Forward = True
.Wrap = wdFindContinue
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^l"
.Replacement.Text = " "
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
End If
Response1 = MsgBox("Do you want to delete empty paragraphs in this
document?", vbYesNo)
If Response1 = vbYes Then
For Each EP In ActiveDocument.Paragraphs
If Len(EP.Range.Text) = 1 Then EP.Range.Delete
Next EP
End If


End Sub
 
Back
Top