Delete last section in Word VBA without the previous heading getting overwritten - vba

Question

I have the following code that I found when googleing on the problem. The problem with this code is that it overwrites the next-to-last section header (and footer though I only need the header preserved) to that of the last section, which is the default (strange) behavior of Word.
Is there a workaround to this in VBA?
Here is the code that has the inherent fault:
Sub DeleteLastSection()
'Deletes last section of a document including
'the section break
Dim doc As Document
Dim rng As Range
Dim ctr As Integer
Set doc = ActiveDocument
ctr = doc.Sections.Count
Set rng = doc.Sections(ctr).Range
Dim myheader As HeaderFooter
If ctr > 1 Then
With rng
.Select
.MoveStart Unit:=wdCharacter, Count:=-1
.Delete
End With
End If
End Sub
Note: The entire range of the last section is being deleted by the code and that is the required behavior. The inherent problem in the default behavior of Word is what I needed a workaround for in VBA code. One can found complex manual procedures to avoid it, but I needed a simple approach in code.

Answer 1

The problem here lies in the fact that the section break carries the section information. If you delete it, the last section becomes part of the section before. The trick I use below is to create a continuous section break instead of a page break, and then do all the rest:
Sub DeleteLastSection()
'Deletes last section of a document including
'the section break
Dim doc As Document
Dim rng As Range
Dim NewEndOfDocument As Range
Dim ctr As Integer
Set doc = ActiveDocument
ctr = doc.Sections.Count
Set rng = doc.Sections(ctr).Range
If ctr > 1 Then
' Create a section break at the end of the second to last section
Set NewEndOfDocument = doc.Sections(ctr - 1).Range
NewEndOfDocument.EndOf wdSection, wdMove
doc.Sections.Add NewEndOfDocument, wdSectionContinuous
With rng
.Select
.MoveStart Unit:=wdCharacter, Count:=-1
.Delete
End With
End If
End Sub

Answer 2

Ordinarily, deleting a Section break causes the Section preceding the break to assume the page layout of the following Section. The following macro works the other way, across multiple (selected) Section breaks. All common page layout issues (margins, page orientation, text columns, headers & footers) are addressed. As you can see by studying the code, it's no trivial task to do all these things.
Sub MergeSections()
Application.ScreenUpdating = False
Dim sPageHght As Single, sPageWdth As Single
Dim sHeaderDist As Single, sFooterDist As Single
Dim sTMargin As Single, sBMargin As Single
Dim sLMargin As Single, sRMargin As Single
Dim sGutter As Single, sGutterPos As Single
Dim lPaperSize As Long, lGutterStyle As Long
Dim lMirrorMargins As Long, lVerticalAlignment As Long
Dim lScnStart As Long, lScnDir As Long
Dim lOddEvenHdFt As Long, lDiffFirstHdFt As Long
Dim bTwoPagesOnOne As Boolean, bBkFldPrnt As Boolean
Dim bBkFldPrnShts As Boolean, bBkFldRevPrnt As Boolean
Dim lOrientation As Long, oHdFt As HeaderFooter
Dim Sctn1 As Section, Sctn2 As Section
With Selection
If .Sections.Count = 1 Then
MsgBox "Selection does not span a Section break", vbExclamation
Exit Sub
End If
Set Sctn1 = .Sections.First: Set Sctn2 = .Sections.Last
With Sctn1.PageSetup
lPaperSize = .PaperSize
lGutterStyle = .GutterStyle
lOrientation = .Orientation
lMirrorMargins = .MirrorMargins
lScnStart = .SectionStart
lScnDir = .SectionDirection
lOddEvenHdFt = .OddAndEvenPagesHeaderFooter
lDiffFirstHdFt = .DifferentFirstPageHeaderFooter
lVerticalAlignment = .VerticalAlignment
sPageHght = .PageHeight
sPageWdth = .PageWidth
sTMargin = .TopMargin
sBMargin = .BottomMargin
sLMargin = .LeftMargin
sRMargin = .RightMargin
sGutter = .Gutter
sGutterPos = .GutterPos
sHeaderDist = .HeaderDistance
sFooterDist = .FooterDistance
bTwoPagesOnOne = .TwoPagesOnOne
bBkFldPrnt = .BookFoldPrinting
bBkFldPrnShts = .BookFoldPrintingSheets
bBkFldRevPrnt = .BookFoldRevPrinting
End With
With Sctn2.PageSetup
.GutterStyle = lGutterStyle
.MirrorMargins = lMirrorMargins
.SectionStart = lScnStart
.SectionDirection = lScnDir
.OddAndEvenPagesHeaderFooter = lOddEvenHdFt
.DifferentFirstPageHeaderFooter = lDiffFirstHdFt
.VerticalAlignment = lVerticalAlignment
.PageHeight = sPageHght
.PageWidth = sPageWdth
.TopMargin = sTMargin
.BottomMargin = sBMargin
.LeftMargin = sLMargin
.RightMargin = sRMargin
.Gutter = sGutter
.GutterPos = sGutterPos
.HeaderDistance = sHeaderDist
.FooterDistance = sFooterDist
.TwoPagesOnOne = bTwoPagesOnOne
.BookFoldPrinting = bBkFldPrnt
.BookFoldPrintingSheets = bBkFldPrnShts
.BookFoldRevPrinting = bBkFldRevPrnt
.PaperSize = lPaperSize
.Orientation = lOrientation
End With
With Sctn2
For Each oHdFt In .Footers
oHdFt.LinkToPrevious = Sctn1.Footers(oHdFt.Index).LinkToPrevious
If oHdFt.LinkToPrevious = False Then
Sctn1.Headers(oHdFt.Index).Range.Copy
oHdFt.Range.Paste
End If
Next
For Each oHdFt In .Headers
oHdFt.LinkToPrevious = Sctn1.Headers(oHdFt.Index).LinkToPrevious
If oHdFt.LinkToPrevious = False Then
Sctn1.Headers(oHdFt.Index).Range.Copy
oHdFt.Range.Paste
End If
Next
End With
While .Sections.Count > 1
.Sections.First.Range.Characters.Last.Delete
Wend
Set Sctn1 = Nothing: Set Sctn2 = Nothing
End With
Application.ScreenUpdating = True
End Sub

Answer 3

Looking more into this on my own (I had to solve the issue in short order and could not wait), I came to the same conclusion as was noted in the comment by #CindyMeister that when deleting the last "section break" in actual fact the next-to-last section is being deleted, and what data and formatting heretofore belonged to the last section is apparently inherited by the new last section (i.e. the earlier next-to-last section). But in reality the last section remained and only the section break was deleted, so what was deleted was the next-to-last section (and the actual pages from the last section).
I found that the LinkToPrevious property of the HeaderFooter object allows a simplistic approach to "inherit" the settings from the previous section.
So by adding a few lines to set this property to true in each instance and then change it back to false, I can get the required behavior of the next-to-last section remaining the same as before.
(Please note that it worked for me because I simply had different text in the primary header, and did not have special formatting and else. But I suspect that based on the workings of the LinkToPrevious property this is a panacea. Please comment if otherwise.)
These are the lines to set the property:
for each hf in .Sections(1).Headers
hf.LinkToPrevious = True
hf.LinkToPrevious = False
next
for each hf in .Sections(1).Footers
hf.LinkToPrevious = True
hf.LinkToPrevious = False
next
The full working code for progeny:
Sub DeleteLastSection()
'Deletes last section of a document including
'the section break
Dim doc As Document
Dim rng As Range
Dim ctr As Integer
Set doc = ActiveDocument
ctr = doc.Sections.Count
Set rng = doc.Sections(ctr).Range
Dim myheader As HeaderFooter
If ctr > 1 Then
With rng
'Added lines to "inherit" the settings from the next-to-last section
for each hf in .Sections(1).Headers
hf.LinkToPrevious = True
hf.LinkToPrevious = False
next
for each hf in .Sections(1).Footers
hf.LinkToPrevious = True
hf.LinkToPrevious = False
next
.Select
.MoveStart Unit:=wdCharacter, Count:=-1
.Delete
End With
End If
End Sub

Answer 4

Deleting the last section of a word document is not a trivial task.
Things you might have to do if items are different between the 'next to last' and 'last' section of a document.
Ensure that in the last section any 'linktoprevious' in a header or footer is set to to false
Copy all headers and footers from the next to last section to the last section
Copy the relevant page format items of the next to last section to the last section (paper size, orientation, margins etc)
Get the range for the last section in the document. Move the end of the range backward until the ascii value is >=32.
Then you can safely delete the adjusted range from your document without any nasty side effects

Answer 5

This is the code I just created that works well:
Sub DeleteLastPage()
Dim pgSetUp As PageSetup
Dim iSect As Integer
iSect = ActiveDocument.Sections.Count - 1
Set pgSetUp = ActiveDocument.Sections(iSect).PageSetup
With ActiveDocument.Sections.Last.PageSetup
.LineNumbering.Active = pgSetUp.LineNumbering.Active
.Orientation = pgSetUp.Orientation
.TopMargin = pgSetUp.TopMargin
.BottomMargin = pgSetUp.BottomMargin
.LeftMargin = pgSetUp.LeftMargin
.RightMargin = pgSetUp.RightMargin
.Gutter = pgSetUp.Gutter
.HeaderDistance = pgSetUp.HeaderDistance
.FooterDistance = pgSetUp.FooterDistance
.PageWidth = pgSetUp.PageWidth
.PageHeight = pgSetUp.PageHeight
.SectionStart = wdSectionNewPage
.OddAndEvenPagesHeaderFooter = pgSetUp.OddAndEvenPagesHeaderFooter
.DifferentFirstPageHeaderFooter = pgSetUp.DifferentFirstPageHeaderFooter
.VerticalAlignment = wdAlignVerticalTop
End With
With ActiveDocument.Sections.Last.Headers(wdHeaderFooterPrimary)
.LinkToPrevious = true
End With
With ActiveDocument.Sections.Last.Footers(wdHeaderFooterPrimary)
.LinkToPrevious = true
End With
ActiveDocument.Sections.Last.Range.Characters.Delete
Selection.EndKey Unit:=wdStory
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.Delete Unit:=wdCharacter,Count:=1
End Sub