Macro to remove a word in a specific heading level?

[Refresher]

Hi,

I am hoping someone can help asnwer this question:

Let's say I have a word "XYZ" scattered throughout my Word document. That
Word document contains many heading levels, like:

1.
1.1
1.1.1
1.1.1.1

How do I write a macro that can remove "XYZ" only if it is in the 4th
heading level (e.g. 1.1.1.1, 1.1.1.2, 2.1.2.3, etc.)?

Also, how do I make it so the macro can also search for text blocks that
span multiple lines, like, for example,:

A
• B
C
• D

I want to be able to find and replace all text blocks that have exactly the
above format and everything, including the bullets.

Thanks.

 

[Helmut Weber]

Hi Refresher

first question:

Sub Test1f()
Dim rDcm As Range
Set rDcm = ActiveDocument.Range
With rDcm.Find
.Text = "xyz"
.Style = "Heading 4"
.Replacement.Text = ""
.Execute Replace:=wdReplaceAll
End With
End Sub>Hi,

second question:

Sub Test2f()
Dim rDcm As Range
Set rDcm = ActiveDocument.Range
With rDcm.Find
.Text = "A^pB^pC^pD^p"
.Replacement.Text = ""
.Execute Replace:=wdReplaceAll
End With
End Sub

Which doesn't take care of bullets and tabs.
If you want to take care of that, too,
you'd have to check if each second paragraph
in the found range is a listparagraph with
the appropriate character as liststring.

--

Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Vista Small Business, Office XP

 

[Refresher]

Hi Helmut,
Thanks for the reply. I really appreciate it.
However, I think there is a misunderstanding.

For the first set of code you gave me, I am not looking for "xyz" that has a
style of "Heading 4". I am looking for "xyz" within a "Heading 4" section.
So, if you had:

1. Title 1

xyz

1.1 Title 2

xyz

1.1.1 Title 3

xyz

1.1.1.1 Title 4

xyz


I would only want to delete the "xyz" in the 1.1.1.1 section.

Does that make sense?

 

[Refresher]

OK,

Using some advice from this link:

http://www.microsoft.com/office/com...1b-9790-2e5db2c7d9ef&cat=&lang=&cr=&sloc=&p=1

I came up with the following, which I think works pretty well:

Sub DeleteMe()
'
' DeleteMe Macro
'
'
Dim sectionNumStr As String
Dim level As Integer
Set Source = ActiveDocument
Source.Activate
Selection.HomeKey wdStory
Selection.Find.ClearFormatting
With Selection.Find
Do While .Execute(Findtext:="xyz", Forward:=True, _
MatchWildcards:=False, Wrap:=wdFindStop) = True
'If Selection.Style = "BoldItalic" Then
'MsgBox
ActiveDocument.Bookmarks("\HeadingLevel").Range.ListFormat.ListString
sectionNumStr =
ActiveDocument.Bookmarks("\HeadingLevel").Range.ListFormat.ListString
'MsgBox UBound(Split(sectionNumStr, "."))
level = UBound(Split(sectionNumStr, "."))
If level = 4 Then
Selection.Delete
End If
'End If
Loop
End With
End Sub

 

[Refresher]

Actually it should be

If level = 3 Then

OK,

Using some advice from this link:

http://www.microsoft.com/office/com...1b-9790-2e5db2c7d9ef&cat=&lang=&cr=&sloc=&p=1

I came up with the following, which I think works pretty well:

Sub DeleteMe()
'
' DeleteMe Macro
'
'
Dim sectionNumStr As String
Dim level As Integer
Set Source = ActiveDocument
Source.Activate
Selection.HomeKey wdStory
Selection.Find.ClearFormatting
With Selection.Find
Do While .Execute(Findtext:="xyz", Forward:=True, _
MatchWildcards:=False, Wrap:=wdFindStop) = True
'If Selection.Style = "BoldItalic" Then
'MsgBox
ActiveDocument.Bookmarks("\HeadingLevel").Range.ListFormat.ListString
sectionNumStr =
ActiveDocument.Bookmarks("\HeadingLevel").Range.ListFormat.ListString
'MsgBox UBound(Split(sectionNumStr, "."))
level = UBound(Split(sectionNumStr, "."))
If level = 4 Then
Selection.Delete
End If
'End If
Loop
End With
End Sub