Search for specific heading, change paragraph style only under that heading

[lkpederson]

Here's an example of the text to change:
Style 1. text
Style 2. text

Style 3. text

Style 2. Text we're searching for

Style 3. text

Style 4. Change this from Style 4 to Style 4A
Style 4. Same as above.

Style 3. text

Style 4. Same as Style 4 above. Stop style changes from Style 4 to Style 4A.

Style 2. text

Style 3. text

The code I currently have selects the colored in green, as it should, however the style replacing after changes ALL Style 4's to Style 4A's. Not helpful. See code below. Thank you.


Sub FormatRefStds() Selection.HomeKey Unit:=wdStory
Application.ScreenUpdating = False
Dim RngFnd As Range, k As Integer, m As Integer

With ActiveDocument
Set RngFnd = .Range
With .Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Replacement.Text = ""
.Text = "REFERENCE STANDARDS"
.Style = "_03_CSI ARTICLE"
.Format = True
.Forward = True
.Wrap = wdFindContinue
.MatchCase = True
.MatchWholeWord = True
.MatchWildcards = False
.Execute
End With
If .Find.found = True Then
.Start = .Paragraphs.Last.Range.End
RngFnd.Start = .Start
End If
With .Find
.Text = ""
.Execute
End With

If .Find.found Then RngFnd.End = .Start
End With
With .Range
With .Find
.Text = ""
.Replacement.Text = ""
.Style = "_05_CSI Subparagraph 1"
.Replacement.Style = "_05RS_CSI Subparagraph1 - Reference Standards"
.MatchWildcards = False
.Wrap = wdFindStop
.Execute Replace:=wdReplaceAll
End With

End With
End With
Application.ScreenUpdating = True
End Sub

[lkpederson]

Figured it out. Added a new range variable and passed the original range to new range, then searched and changed the styles.


Sub FormatRefStds()
Selection.HomeKey Unit:=wdStory
Application.ScreenUpdating = False
Dim RngFnd As Range, k As Integer, m As Integer, RndSm As Range

With ActiveDocument
Set RngFnd = .Range
With .Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Replacement.Text = ""
.Text = "REFERENCE STANDARDS"
.Style = "_03_CSI ARTICLE"
.Format = True
.Forward = True
.Wrap = wdFindContinue
.MatchCase = True
.MatchWholeWord = True
.MatchWildcards = False
.Execute
End With
If .Find.found = True Then
.Start = .Paragraphs.Last.Range.End
RngFnd.Start = .Start
End If
With .Find
.Text = ""
.Execute
End With

If .Find.found Then RngFnd.End = .Start
Set RngSm = RngFnd
End With
With RngSm
With .Find
.Text = ""
.Replacement.Text = ""
.Style = "_05_CSI Subparagraph 1"
.Replacement.Style = "_05RS_CSI Subparagraph1 - Reference Standards"
.MatchWildcards = False
.Wrap = wdFindStop
.Execute Replace:=wdReplaceAll
End With

End With
End With
Application.ScreenUpdating = True
End Sub

[gmaxey]

See:

Try:


Sub FormatRefStds()
Application.ScreenUpdating = False
Dim RngFnd As Range, RngBounds As Range
With ActiveDocument
Set RngFnd = .Range
With .Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "TWO"
.Style = "Heading 1"
.Execute
End With
If .Find.Found = True Then
.Start = .Paragraphs.Last.Range.End
RngFnd.Start = .Start
End If
With .Find
.Text = ""
.Execute
End With
If .Find.Found Then RngFnd.End = .Start

End With
With RngFnd
Set RngBounds = RngFnd.Duplicate
.Select
With .Find
.Style = "StyleA"
.MatchWildcards = False
.Wrap = wdFindStop
While .Execute
RngFnd.Select
If RngFnd.InRange(RngBounds) Then
RngFnd.Style = "StyleAX"
End If
Wend
End With
End With
End With
Application.ScreenUpdating = True
End Sub


See: http://gregmaxey.mvps.org/word_tip_pages/words_fickle_vba_find_property.html