Help with deleting text between headings

[sdjwalls]

Hello,

I've been trying to come up with a macro that will identify a heading based on a particular style, and then delete everything under that heading (including any sub-headings and their contents). I can get to where I find the heading that I want, and I can delete it, but not the following contents under it.

Thank you for any help!!
SW

[macropod]

Hi SW,

What is the rule the code should use to decide when to stop?

What is your code so far? It's a bit hard to suggest what changes might be appropriate without seeing your code.

[sdjwalls]

Hello,

It's currently looking based on a style. So if it finds a style called "Int Heading 2", it should delete everything until it finds another "Int Heading 2" or a "Int Heading 1" (basically, the current level heading or greater).

To put it another way:

1 Chapter on XYZ
1.1 Sub-chapter of XYZ
1.1.1 Another sub-chapter
1.2 Sub-chapter of XYZ
2 Chapter on ABC

Let's say 1.1 had a specific chapter heading style "Int Heading 2", while the other headings just have the regular style "Heading #". I would then want to delete all of 1.1, including 1.1.1, but not 1.2. Unless of course that 1.2 also had the "Int Heading #" style.

Here's my starting point (leveraged from old code), and I can't figure out how to expand it to search for the next heading of a <= level and delete everything in between:

With Selection.Find
.ClearFormatting
Selection.Find.Style = ActiveDocument.Styles("Int Heading 2")
Text = ""
With .Replacement
.ClearFormatting
.Text = ""
End With
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=wdReplaceAll
End With

I'm a newbie with VBA, so help is definitely appreciated!!
SW

[macropod]

Hi SW,

Perhaps something like:
Public Sub CleanUp()
Dim TrkStatus As Boolean
Dim KeepStyle As String
Dim oSty As Style
Dim ValidSty As Boolean
With ActiveDocument
KeepStyle = InputBox("Style to keep")
ValidSty = False
For Each oSty In .Styles
If oSty.NameLocal <> KeepStyle Then ValidSty = True
Next oSty
If ValidSty = True Then
Application.ScreenUpdating = False
' Store current Track Changes status, then switch off
TrkStatus = .TrackRevisions
.TrackRevisions = False
For Each oSty In .Styles
If oSty.Type = wdStyleTypeParagraph Then
If oSty.NameLocal <> KeepStyle Then
With .Content.Find
.Style = ActiveDocument.Styles(oSty)
.Text = "*"
.Replacement.Text = ""
.Replacement.ClearFormatting
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
.Execute Replace:=wdReplaceAll
End With
End If
End If
Next oSty
' Restore original Track Changes status
ActiveDocument.TrackRevisions = TrkStatus
Application.ScreenUpdating = True
Exit Sub
Else
MsgBox KeepStyle & " is not a valid Style for this document"
End If
End With
End Subto delete everything in the document that is not of the specified Style. Do note that, with a large document using many Styles, this could take a while to complete.

If you only want to process a selection, change '.Content' to 'Selection'. Note also that any tables in the selected range will remain, with the former style attributes, but the cells will be empty.

[sdjwalls]

Hi,

Thanks for your reply...

I tried this on my basic doc of 33 pages, and it locked up word (it kept going and going and going...). Any other docs based on this template will likely be longer. And I'm not sure it'll do what I'm looking for.

To simplify it a little, is it possible to get to the instances of a collection of styles? For example:

ActiveDocument.Styles("Int Heading 1")

will return a collection. Can I set a the beginning of a range to the first instance of "Int Heading 1"? If I could do that, then I should be able to set the end of the range, and then I can delete it... It seems like it should be possible (famous last words)??

Thanks,
Pam

[macropod]

Hi SW,

There's no way of using the Styles collection to automatically process all text based on a particular style, other than to change its attributes.

However, if you change the line:
If oSty.NameLocal <> KeepStyle Then
to:
If oSty.NameLocal <> KeepStyle And oSty.InUse = True Then
the code should run somewhat faster (it should run faster still if you turn these two tests into consecutive IF tests instead of combining them with the AND statement as I have done for simplicity).

[sdjwalls]

Hi Macropod,

thanks again-i'll give this a try. for some reason, my email wasn't showing that there were updates to this post...

SW