Insert a page break before each of occurrence of a certain term in Column 4 in the currently selected table

Dear Experts:

I got a huge table (spanning over a lot of pages and having no header row) in the Active Document. In Column 4 of this table, the term 'Product' or 'Set' appears off and on.

And now I would like to run a macro ...
... to split this huge table by inserting a page break before each occurrence of the term 'Product'. That is, in the end, the huge table will be split up into, say, 30 tables, each separated by a page break. All these tables will have either the term 'Product' or 'Set' in the 4th column of the first row.

Help is much appreciated. Thank you very much in advance.

Regards, Andreas
Andreas HermleTeam leaderAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

FarWestCommented:
check this code
Public Function FindAndSplictTable()
Dim searchStr(2) As String
Dim order As Integer
searchStr(0) = "Product"
searchStr(1) = "Set"
Application.ScreenUpdating = False

For order = 0 To 1
Dim myRange As Range
Set myRange = ActiveDocument.Content

With myRange.Find
.MatchWildcards = False
.Forward = False
.Text = searchStr(order)
.MatchWholeWord = True
Do While .Execute() = True
If myRange.Information(wdWithInTable) Then
 With myRange
If .Information(wdStartOfRangeRowNumber) <> 1 And .Information(wdStartOfRangeColumnNumber) Then ' check if it is first row and column 4
 .Tables(1).Split .Information(wdStartOfRangeRowNumber)
End If
 End With
End If
myRange.Collapse wdCollapseStart
Loop
 End With
 Next
Application.ScreenUpdating = True
MsgBox ("done")

End Function

Open in new window

Andreas HermleTeam leaderAuthor Commented:
Hi FarWest,

thank you very much for your swift and professional help. Works great, the table gets split up into subtables whenever the code hits the terms 'Product' or 'Set'.

But I am afraid to tell you that there is one thing I still would like to get incorporated in this nice code, that is, the ensuing subtables are to be separated by manual page breaks.

Help is much appreciated. Thank you very much in advance.

Regards, Andreas
Rgonzo1971Commented:
HI,

pls try

Sub Macro()
For Each rw In ActiveDocument.Tables(1).Rows
    If rw.Cells(4).Range.Text Like "Set*" Or rw.Cells(4).Range.Text Like "Product*" Then
        rw.Range.ParagraphFormat.PageBreakBefore = True
    End If
Next
End Sub

Open in new window

Regards

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Bootstrap 4: Exploring New Features

Learn how to use and navigate the new features included in Bootstrap 4, the most popular HTML, CSS, and JavaScript framework for developing responsive, mobile-first websites.

Andreas HermleTeam leaderAuthor Commented:
Hi Rgonzo,

I was looking for manual page breaks, but the property 'page break before' is also fine.

Thank you very much for your professional and swift support.

Regards, Andreas
Andreas HermleTeam leaderAuthor Commented:
Hi Rgonzo,

just in case I may need it in the future, how would your code look like if I wanted to have manual page breaks instead of the property 'PageBreakBefore'

Thank you very much in advance. Regards, Andreas
Rgonzo1971Commented:
HI,

pls try

Sub Macro()
For Idx = ActiveDocument.Tables(1).Rows.Count To 1 Step -1
    Set rw = ActiveDocument.Tables(1).Rows(Idx)
    If rw.Cells(4).Range.Text Like "Set*" Or rw.Cells(4).Range.Text Like "Product*" Then
        rw.Range.InsertBreak Type:=wdPageBreak
    End If
Next
End Sub

Open in new window

EDIT Shorter

Regards
Andreas HermleTeam leaderAuthor Commented:
Hi Rgonzo, as always, nice and professional coding from your side. Thank you very much for your professional help.

Regards, Andreas
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Word

From novice to tech pro — start learning today.