Consulting

Results 1 to 7 of 7

Thread: Help with deleting text between headings

  1. #1
    VBAX Newbie
    Joined
    Aug 2008
    Posts
    4
    Location

    Help with deleting text between headings

    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

  2. #2
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    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.
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  3. #3
    VBAX Newbie
    Joined
    Aug 2008
    Posts
    4
    Location
    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

  4. #4
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    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 Sub
    to 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.
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  5. #5
    VBAX Newbie
    Joined
    Aug 2008
    Posts
    4
    Location
    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

  6. #6
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    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).
    Last edited by macropod; 08-18-2008 at 04:54 PM.
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  7. #7
    VBAX Newbie
    Joined
    Aug 2008
    Posts
    4
    Location
    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

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •