How do I extend a selection

[Shimon]

Hello All,
I would like to replace formatting between two strings, I know how to find
the first string and format but I don't know how to select a group of words
/ paragraphs in between a specific sequence of characters i.e

any text between aaaaaaa and zzzzzzzz should have a specific format.
Thanks in advance,
Shimon

 

[Greg Maxey]

Here is a couple of macros I cobbled together that through limited testing
seem to work. One uses wildcards and the other doesn't:

Option Explicit

Sub ScratchMacro1()
FormatBetween "aaaaaaa", "zzzzzzz"
End Sub

Sub FormatBetween(sA$, sB$)

Dim oRng As Range
Dim myRange As Range
Dim i As Long

Resetsearch

Set oRng = ActiveDocument.Range
ActiveDocument.Range(0, 0).Select
With oRng.Find
.Text = sA$
.Wrap = wdFindStop
While .Execute
oRng.Select
j = oRng.End
oRng.Collapse direction:=wdCollapseEnd
.Text = sB$
If .Execute Then
Set myRange = oRng.Duplicate
myRange.Start = i + 1
myRange.End = oRng.Start - 1
myRange.Select
myRange.Font.Color = wdColorBlue
.Text = sA$
oRng.Collapse direction:=wdCollapseEnd
End If
Wend
End With
End Sub

Sub Resetsearch()
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
End With
End Sub

Sub ScratchMacro2()
Dim myRange As Range
Dim myString As String
Dim myString2 As String
Set myRange = ActiveDocument.Range
With myRange.Find
.ClearFormatting
.MatchWildcards = True
.Text = "aaaaaaa" & "*" & "zzzzzzz"
While .Execute
myRange.Start = myRange.Start + 8
myRange.End = myRange.End - 8
With myRange
.Font.Color = wdColorBlue
End With
myRange.Collapse direction:=wdCollapseEnd
Wend
End With
End Sub

 

[Greg Maxey]

Shimon,

Is this what you are looking for:

Sub ScratchMacro2()
Dim myRange As Range
Dim startFlag As String
Dim endFlag As String
Dim x As Integer
Dim y As Integer
Set myRange = ActiveDocument.Range
startFlag = InputBox("Enter the start flag (e.g., aaaa)", "Start Flag")
x = Len(startFlag)
endFlag = InputBox("Enter the end flag (e.g., zzzz)", "End Flag")
y = Len(endFlag)
With myRange.Find
.ClearFormatting
.MatchWildcards = True
.Text = startFlag & "*" & endFlag
While .Execute
myRange.Start = myRange.Start + x
myRange.End = myRange.End - y
With myRange
.Font.Color = wdColorBlue
End With
myRange.Collapse direction:=wdCollapseEnd
Wend
End With
End Sub

 

[Shimon]

Hi Greg,
Thanks alot, ScratchMacro2 works great. There is one addition I would like
to make. I would like to replace the aaaa and zzzz with other text. I can do
a regular find and replace, but I was wondering if there was a more elegant
way.
Thanks in advance,
Shimon

 

[Greg Maxey]

Shimon,

With a little additional testing I found that using a one of the wildcard
symbols as the start or end flag could cause errors or loops unless
preceeded by a backslash \.

Take the example:

Now is @ the time for all good * men to come @ to the aid of thier *
country.

The @ is the start flag and the * is the end flag. As both are wildcard
characters, they should be put in the input box as \@ and \*

If we had:

Now is ~ the time for all good + men to come ~ to the aid of thier +
country.

Since niether the start flag ~ or the end flag + is a wildcard character,
they could be entered directly as ~ and +

If you don't want to chop the strings to exclude the start and end flags
then just delete the lines I have marked with ***

Sub ScratchMacro2()
Dim myRange As Range
Dim startFlag As String
Dim endFlag As String
Dim x As Integer ***
Dim y As Integer ***
Set myRange = ActiveDocument.Range
startFlagRetry:
startFlag = InputBox("Enter the start flag (e.g., aaaa)", "Start Flag")
If InStr("!@*(){}[]{?<>", startFlag) > 0 Then
MsgBox "Each wildcard symbol (!@*(){}]{?<>) used for flags" _
& " must be preceded by a backslash \", vbOKOnly
GoTo startFlagRetry
End If
x = Len(startFlag) ***
endFlagRetry:
endFlag = InputBox("Enter the end flag (e.g., zzzz)", "End Flag")
If InStr("!@*(){}[]{?<>", endFlag) > 0 Then
MsgBox "Each wildcard symbol (!@*(){}]{?<>) used for flags" _
& " must be preceded by a backslash \", vbOKOnly
GoTo endFlagRetry
End If
y = Len(endFlag) ***
With myRange.Find
.ClearFormatting
.MatchWildcards = True
.Text = startFlag & "*" & endFlag
While .Execute
myRange.Start = myRange.Start + x ***
myRange.End = myRange.End - y ***
With myRange
.Font.Color = wdColorGreen
End With
myRange.Collapse direction:=wdCollapseEnd
Wend
End With
End Sub

 

[Shimon]

Hi Greg,
Thanks for the prompt reply.
I figured out how to enter the string by input box, the result does not have
to consider the length of the input string, as the style that I apply is
applied to the whole string. I would like the option of replacing the "aaa"
and "zzz" with some other string, as these strings are put there ( by a
third party application) for the express purpose of changing the formating.
Thanks in advance,
Shimon

Sub SetupRangeAndStyle()
'
' SetupRangeAndStyle Macro
' Macro created ?06/05/2005 by Shimon
'
Dim sA As String
Dim sB As String
Dim sC As String
MsgBox ("This macro will search between two sets of strings and replace the
formatting ")
sA = InputBox("Enter begining string")
sB = InputBox("Enter end string")
sC = InputBox("Enter style name")
' can be used without Input Box FormatAndStyleBetween "aaa", "zzz",
"Header"

MsgBox ("Will look for " + sA + " and " + sB + " and apply syle " + sC)
FormatAndStyleBetween sA, sB, sC
End Sub





Sub FormatAndStyleBetween(sA$, sB$, sC$)
Dim myRange As Range
' Dim myString As String
' Dim myString2 As String
Set myRange = ActiveDocument.Range
With myRange.Find
.ClearFormatting
.MatchWildcards = True
.Text = sA$ & "*" & sB$
While .Execute

With myRange

.Style = sC$


End With

myRange.Collapse Direction:=wdCollapseEnd
Wend
End With
End Sub