Have an easy way to remove extra line breaks in Word?

P

PJ

I often need to import text files from other applications into Word.
Frequently these files have hard breaks at the end of each line. I'd like an
easy (macro, script, etc) way to remove the extra breaks so the lines wrap
naturally.

Thanks!
 
G

Greg Maxey

PJ,

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

I use this macro to CleanUp 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
 
P

PJ

Fantastic! Thanks Greg!

Greg Maxey said:
PJ,

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

I use this macro to CleanUp 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

--
Greg Maxey/Word MVP
A Peer in Peer to Peer Support
I often need to import text files from other applications into Word.
Frequently these files have hard breaks at the end of each line. I'd
like an easy (macro, script, etc) way to remove the extra breaks so
the lines wrap naturally.

Thanks!
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top