Deleting empty paragraphs and spaces at end of document

[Santa Claus]

Hi, finally nearing the end of my project. Thanks to those who have helped.

I'm selecting and saving pages into a new document. Often there are five or
six carriage returns at the end of a page that is copied into a new
document. There might also be a number of spaces. Im wanting to delete
these.....so the last character in my new document is text or not null. I
dont want to tinker with the rest of the document.

I guess I want to go to the end of the document and use a look macro to test
if it is an empty paragraph or space. I can keep deletinhg until i reach
text.

I've search the web...found a few macros that are close, but they all seem
to edit the whole document. I only want to edit the end of the document.

Anyone able to point me in the right direction?

Thanks

 

[Tony Jollans]

No real need for code for this but you can record a macro if you want some.

Go to the end of the document (Ctrl+End)
Find and Replace (Ctrl+h)

Find [ ^13]{1,} - that's left (square) bracket, caret, one, three, right
(square) bracket, left brace, one, comma, right brace

Replace - leave blank

(Make sure there's no formatting applied - go to each of the Find and
Replace boxes and press No Formatting if it's not greyed out)

Select Up for Search direction
Check Use Wildcards

Hit Find Next
Hit Replace

 

[Helmut Weber]

Hi Santa,

that's what I use, for a lot of different reasons,
which would take too much time to explain.
Just one point is to leave the last paragraph mark untouched,
as it is the end-of-doc mark at the same time.

Public Sub PurgeDocEnd()
If Len(ActiveDocument.Range) = 1 Then Exit Sub
Dim z As Long
Dim r As Range
With ActiveDocument
z = .Range.End
Set r = .Range(z - 2, z - 1)
While r.Text = " " Or r.Text = Chr$(13)
r.Delete
z = .Range.End
Set r = .Range(z - 2, z - 1)
Wend
End With
End Sub

Greetings from Bavaria, Germany
Helmut Weber, MVP WordVBA
"red.sys" & chr(64) & "t-online.de"
Word 2002, Windows 2000

 

[Santa Claus]

Hi Helmut, you are incredible....absolute legend!!!

Works perfectly for return's, but small problem with spaces .....seems
to get stuck but can't work out why.

For spaces, it seems to get caught behind the range being tested. I
could make an adjustment, but it has me affled as to why it is getting
stuck.

Do you get the same problem?

 

[Helmut Weber]

Hi Santa,

the macro has been in use for quite some years,
and I never changed it. I wouldn't do it quite same way again.
It looks now odd to me in some details,
however,
my users never put in protected spaces [ctrl shift spacebar], chr(160),
which hopefully is the cause for the trouble.

If so, just add chr(160), like:

While r.Text = " " Or r.Text = Chr(160) Or r.Text = Chr$(13)

HTH

Greetings from Bavaria, Germany
Helmut Weber, MVP WordVBA
"red.sys" & chr(64) & "t-online.de"
Word 2002, Windows 2000

 

[Helmut Weber]

Hi Santa,

(best to use a non-proportional font to display the posting)

You wouldn't believe how complicated this can be,
but if you want to know the whole truth....

There are 5 kinds of spaces,
you might include tabs if you like.

ordinary ascW(32)
non-breaking ascW(160)
em-space ascW(8195)
en-space ascW(8194)
¼-em-space ascW(8197)

What I first do is to delete spaces before paragraph marks.
I think they are of no use.
Why? Cause simple replacement may ruin formatting, held in
the paragraph marks.

Sub PurgeParagraphEnd()
Dim lChr As Long
Dim rPrg As Paragraph
Dim rTmp As Range
Dim sTmp As String
With ActiveDocument
For Each rPrg In .Paragraphs
Set rTmp = rPrg.Range
rTmp.Collapse Direction:=wdCollapseEnd
rTmp.End = rTmp.End - 1
While IsSpace(rTmp.Previous.Text)
rTmp.Previous.Delete
Wend
Next
' looks good, but leaves a space beore the last paragraph mark
' if there was more than one space before,
' needs special treatment. Don't know why.
sTmp = .Characters.Last.Previous
lChr = .Characters.Count
If IsSpace(sTmp) Then
.Characters(lChr - 1).Delete
End If
End With
End Sub

Thanks for the flowers, by the way,
but not to touch the last paragraph mark
was nonsense. To preserve formatting,
quite the opposite is required.
Delete the last paragraph mark,
after having run PurgeParagraphEnd,
until there isn't a paragraph mark anymore,
preceding the last paragraph mark...

All together:

' ---
Public Function IsSpace(ByVal sTmp As String) As Boolean
Select Case AscW(sTmp)
Case 32, 160, 8195, 8194, 8197: IsSpace = True
Case Else: IsSpace = False
End Select
End Function
' ---
Sub PurgeDocEnd()
Dim rDcm As Range
Set rDcm = ActiveDocument.Range
PurgeParagraphEnd
While ActiveDocument.Characters.Last.Previous = Chr(13)
ActiveDocument.Characters.Last.Delete
Wend
End Sub

Enjoy!

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Win XP, Office 2003
"red.sys" & Chr$(64) & "t-online.de"

 

[Robert]

my users never put in protected spaces [ctrl shift spacebar], chr(160),

which hopefully is the cause for the trouble.
If so, just add chr(160), like:

While r.Text = " " Or r.Text = Chr(160) Or r.Text = Chr$(13)

Dear Helmut,
I am rather more interested in the first, the simpler, of your macros
which, when pasted into the VBE, worked fine initially.
But after introducing your amendment about Chr(160) Word just hangs.
The VBE indicates "running" and never identifies any fault for me to
trace.

It did occur to me (newbie that I am) that perhaps "Chr(160)" should be
"Chr$(160)", but amending the code made no difference. And now, Word
always hangs when this macro is called, even when in its initial,
unmodified form.
Of course, since Word has done several emergency shut-downs, I don't
know what state the Normal template is now in.

I'd rather like to keep your Sub as it would be very useful to me. Can
you shed any light on what's happening, please?

Many thanks.

Robert

 

[Helmut Weber]

Hi Robert,

don't know what so say.

The original simple macro has been in use for years,
with more than 500,000 docs.

You may send me a problematic doc,
and I'll do whatever I can.

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Win XP, Office 2003
"red.sys" & Chr$(64) & "t-online.de"

 

[Helmut Weber]

All revised and improved, hopefully.

There are quite some years between my first attempt and now.

;-)

Public Sub PurgeDocEnd2005()
Dim s As String
With ActiveDocument
If Len(.Range) = 1 Then Exit Sub
s = .Characters.Last.Previous
While s = " " Or s = Chr(13)
.Characters.Last.Previous = ""
s = .Characters.Last.Previous
Wend
End With
End Sub

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Win XP, Office 2003
"red.sys" & Chr$(64) & "t-online.de"

 

[Robert]

Hello again Helmut,

This leaner version has a certain aesthetic beauty and, I am happy to
say, works perfectly on my machine. I have even added the non-breaking
space, Chr$(160) , to the characters to be pruned from the end of the
doc and this works too.

Many thanks for your kind and helpful suggestions.

Robert

 

[pstraton]

Though this is a very old thread, it's an issue that often arises with Word automation, with difficult pitfalls to be avoided, and I'm not seeing a general solution in this thread. So here's one that can be adapted for problems like Santa Claus's. Note that my demo code doesn't actually use RemoveWholeLines's optional DocRange parameter, but it can be used to limit the document range to which the deletions are applied.

Sub DemoExtractExecutableCodeLines()
'As an example, if VBA code is copied from the VBE editor to the document under which this routine is then
'executed, it will remove all commented lines (except the first one, as noted below) and blank lines, leaving
'only the executable code.

Call RemoveWholeLines("^p'*^p") 'Remove all left-justified, entire-comment lines (except the first one,
'which the user may be using to identify the data set being processed).
Call RemoveWholeLines("^p @'*^p") 'Remove all blank-offset, entire-comment lines (except the first one, as
'noted above).

Call RemoveWholeLines("^p^p") 'Remove all intervening blank lines.
Call RemoveWholeLines("^p @^p") ' "
End Sub

Private Sub RemoveWholeLines(ByVal LinePattern As String, Optional DocRange As Variant)
'Removes entire lines (^p to ^p), in the optionally specified document-range, that match the specified string
'pattern, including any wildcard specifications, and deletes each matching range except for its single,
'trailing ^p (in order to avoid concatenation of adjacent lines). If no document-range is specified, then the
'search range is set to be the entire active document of the file under which this code is executing.
'
'If delimiting "^p" or "^13" characters are not included in the specification, "^13" characters are added.
'The delimiters can be specified as "^p" but will be converted to "^13" since "^p" can't actually be used
'in wildcard searches.
'
'Author: Peter Straton
'
'*************************************************************************************************************

Const PgraphMark As String = "^p"
Const ASCII_CR As String = "^13"

Dim FindRange As Range

If IsMissing(DocRange) Then
ThisDocument.Activate 'In case it isn't
Set DocRange = ActiveDocument.Range
End If
Set FindRange = DocRange

LinePattern = Replace(LinePattern, PgraphMark, ASCII_CR, , , vbTextCompare)
If Left(LinePattern, 3) <> ASCII_CR Then LinePattern = ASCII_CR & LinePattern
If Right(LinePattern, 3) <> ASCII_CR Then LinePattern = LinePattern & ASCII_CR

With FindRange.Find 'Set basic Find parameters...
.ClearFormatting
.Wrap = wdFindStop
.Format = False
.Forward = True
.MatchCase = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.MatchWholeWord = False
End With

'BUG WORKAROUND - BUG WORKAROUND - BUG WORKAROUND - BUG WORKAROUND - BUG WORKAROUND - BUG WORKAROUND - BUG
'
'For reasons that are not understood (apparently by anyone), under some circumstances that are difficult to
'characterize, Word's Find/Replace tool can cause Word to freeze after replacing whole lines (^p to ^p) with
'single or multiple ^p characters. Consequently, the found ranges must be explicitly deleted instead of
'replaced.

Do 'Find each instance of LinePattern and delete them
With FindRange.Find
If Not .Execute(FindText:=LinePattern, MatchWildcards:=True) Then Exit Do 'Must assert MatchWildcards
'each time!
With FindRange
.SetRange Start:=.Start, End:=.End - 1 'Leave trailing ^p
End With
' FindRange.Select 'Debug

FindRange.Delete
Set FindRange = DocRange 'Re-establish find-range as the *now-modified* document range
End With
Loop

'END WORKAROUND - END WORKAROUND - END WORKAROUND - END WORKAROUND - END WORKAROUND - END WORKAROUND - END
End Sub

 

[DanM]

Thank you all for the replies!! much appreciated.
I also found an interesting approach at the following website:
http://stackoverflow.com/questions/19165309/deleting-certain-lines-in-ms-word-2007

The code looks like this, and allows the user to type in leading strings for the lines of the paragraphs that you want o delete. Works pretty good.

Sub Macro2()
Dim arrRemove As Variant
arrRemove = Array("Bottom of Form", "perma -link", "Top of Form", _
"\[+\]", "\[\-\]", "Donec", "In")
Dim i!
For i = 0 To UBound(arrRemove)
Activedocument.Range(0,0).select
Selection.Find.ClearFormatting
With Selection.Find
.Text = arrRemove(i) & "*^13"
.Replacement.Text = "" 'replace with nothing
.Forward = True
.Wrap = wdFindContinue
.MatchCase = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
Next i
End Sub


No need, in my example, to have to use the "/"s.

Dan