Find and Create Range Problem

D

Darren Hill

I'm using Word 2007 on WinXP SP2.

I have several document which have instances of things like:
[BEGIN BOXED TEXT]
(some paragraphs)
[END BOXED TEXT]

I need a macro to search the document for each such instance, and select
it (or create a range) - I can do the rest (probably!).

The method I have at the moment is below and has two problems: one,
after the first loop, the selected range gets too big, and two, it keeps
repeating the first instance of FIND, rather than jumping through them all.

Thanks in advance,
Darren

Sub StyleReset()
'
' StyleReset Macro
'
' CTRL+ALT+`

' (I've snipped out some lines that aren't relevant here
FormatChange "[BEGIN BULLETED LIST]"
FormatChange "[BEGIN BOXED TEXT]"
FormatChange "[BEGIN SIDEBAR]"
FormatChange "[BEGIN TABLE]"


End Sub

Sub FormatChange(FindChar As String, Optional FindStyle As String = "")
Dim MyRange As Range, StartRange As Range

Selection.GoTo What:=wdGoToBookmark, Name:="TextStart"
Selection.Collapse


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = FindChar
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Do While Selection.Find.Execute

Select Case FindChar
' I've snipped out the Cases that are working ok -
' it's the next Case I'm having trouble with
Case "[BEGIN SIDEBAR]", "[BEGIN TABLE]", "[BEGIN BOXED TEXT]",
"[BEGIN BULLETED LIST]"
' need to select the area
' find the first "[END" - set a range within
'
Set MyRange = Selection.Range
MyRange.SetRange Start:=Selection.MoveStart(wdLine, 1),
End:=MyRange.End
MyRange.Collapse wdCollapseStart
Set StartRange = MyRange.Duplicate

With MyRange.Find
.Forward = True
.Wrap = wdFindStop
.Text = "[END"
.Replacement.Text = ""
.Execute

If .Found Then
''Extend the range from the found item back to the
start of the original range
MyRange.Start = StartRange.Start
MyRange.Select
Selection.MoveEnd Unit:=wdLine, Count:=-1
Set MyRange = Selection.Range

' do stuff here



End If
End With

Case "<s>"
' this is a small table. Need to find the first paragraph that
doesn't contain a tab mark.
Case Else

End Select

Loop

End Sub
 
G

Greg Maxey

This might work:

Sub StyleReset()
FormatChange "[BEGIN BOXED TEXT]"
End Sub
Sub FormatChange(FindChar As String, Optional FindStyle As String =
"")
Dim MyRange As Range, StartRange As Range

Set MyRange = ActiveDocument.Range
With MyRange.Find
.Text = FindChar
.Wrap = wdFindStop
While .Execute
Select Case FindChar
Case "[BEGIN SIDEBAR]", "[BEGIN TABLE]", "[BEGIN BOXED TEXT]",
"[BEGIN BULLETED LIST]"
MyRange.Collapse wdCollapseEnd
MyRange.Move Unit:=wdCharacter, Count:=1
MyRange.Select
Set StartRange = MyRange.Duplicate
With MyRange.Find
.Text = "[END"
.Wrap = wdFindStop
If .Execute Then
MyRange.Start = StartRange.Start
MyRange.Select
Selection.MoveEnd Unit:=wdLine, Count:=-1
' do stuff here
MyRange.Collapse wdCollapseEnd
.Text = FindChar
End If
End With
Case "<s>"
Case Else
End Select
Wend
End With
End Sub

I'm using Word 2007 on WinXP SP2.

I have several document which have instances of things like:
[BEGIN BOXED TEXT]
(some paragraphs)
[END BOXED TEXT]

I need a macro to search the document for each such instance, and select
it (or create a range) - I can do the rest (probably!).

The method I have at the moment is below and has two problems: one,
after the first loop, the selected range gets too big, and two, it keeps
repeating the first instance of FIND, rather than jumping through them all.

Thanks in advance,
Darren

Sub StyleReset()
'
' StyleReset Macro
'
' CTRL+ALT+`

' (I've snipped out some lines that aren't relevant here
FormatChange "[BEGIN BULLETED LIST]"
FormatChange "[BEGIN BOXED TEXT]"
FormatChange "[BEGIN SIDEBAR]"
FormatChange "[BEGIN TABLE]"

End Sub

Sub FormatChange(FindChar As String, Optional FindStyle As String = "")
Dim MyRange As Range, StartRange As Range

Selection.GoTo What:=wdGoToBookmark, Name:="TextStart"
Selection.Collapse

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = FindChar
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Do While Selection.Find.Execute

Select Case FindChar
' I've snipped out the Cases that are working ok -
' it's the next Case I'm having trouble with
Case "[BEGIN SIDEBAR]", "[BEGIN TABLE]", "[BEGIN BOXED TEXT]",
"[BEGIN BULLETED LIST]"
' need to select the area
' find the first "[END" - set a range within
'
Set MyRange = Selection.Range
MyRange.SetRange Start:=Selection.MoveStart(wdLine, 1),
End:=MyRange.End
MyRange.Collapse wdCollapseStart
Set StartRange = MyRange.Duplicate

With MyRange.Find
.Forward = True
.Wrap = wdFindStop
.Text = "[END"
.Replacement.Text = ""
.Execute

If .Found Then
''Extend the range from the found item back to the
start of the original range
MyRange.Start = StartRange.Start
MyRange.Select
Selection.MoveEnd Unit:=wdLine, Count:=-1
Set MyRange = Selection.Range

' do stuff here

End If
End With

Case "<s>"
' this is a small table. Need to find the first paragraph that
doesn't contain a tab mark.
Case Else

End Select

Loop

End Sub
Click to expand...
 
D

Darren Hill

THANKS! Yes, it does work. Excellent.

Thanks again,
Darren

Greg said:
This might work:

Sub StyleReset()
FormatChange "[BEGIN BOXED TEXT]"
End Sub
Sub FormatChange(FindChar As String, Optional FindStyle As String =
"")
Dim MyRange As Range, StartRange As Range

Set MyRange = ActiveDocument.Range
With MyRange.Find
.Text = FindChar
.Wrap = wdFindStop
While .Execute
Select Case FindChar
Case "[BEGIN SIDEBAR]", "[BEGIN TABLE]", "[BEGIN BOXED TEXT]",
"[BEGIN BULLETED LIST]"
MyRange.Collapse wdCollapseEnd
MyRange.Move Unit:=wdCharacter, Count:=1
MyRange.Select
Set StartRange = MyRange.Duplicate
With MyRange.Find
.Text = "[END"
.Wrap = wdFindStop
If .Execute Then
MyRange.Start = StartRange.Start
MyRange.Select
Selection.MoveEnd Unit:=wdLine, Count:=-1
' do stuff here
MyRange.Collapse wdCollapseEnd
.Text = FindChar
End If
End With
Case "<s>"
Case Else
End Select
Wend
End With
End Sub

I'm using Word 2007 on WinXP SP2.

I have several document which have instances of things like:
[BEGIN BOXED TEXT]
(some paragraphs)
[END BOXED TEXT]

I need a macro to search the document for each such instance, and select
it (or create a range) - I can do the rest (probably!).

The method I have at the moment is below and has two problems: one,
after the first loop, the selected range gets too big, and two, it keeps
repeating the first instance of FIND, rather than jumping through them all.

Thanks in advance,
Darren

Sub StyleReset()
'
' StyleReset Macro
'
' CTRL+ALT+`

' (I've snipped out some lines that aren't relevant here
FormatChange "[BEGIN BULLETED LIST]"
FormatChange "[BEGIN BOXED TEXT]"
FormatChange "[BEGIN SIDEBAR]"
FormatChange "[BEGIN TABLE]"

End Sub

Sub FormatChange(FindChar As String, Optional FindStyle As String = "")
Dim MyRange As Range, StartRange As Range

Selection.GoTo What:=wdGoToBookmark, Name:="TextStart"
Selection.Collapse

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = FindChar
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Do While Selection.Find.Execute

Select Case FindChar
' I've snipped out the Cases that are working ok -
' it's the next Case I'm having trouble with
Case "[BEGIN SIDEBAR]", "[BEGIN TABLE]", "[BEGIN BOXED TEXT]",
"[BEGIN BULLETED LIST]"
' need to select the area
' find the first "[END" - set a range within
'
Set MyRange = Selection.Range
MyRange.SetRange Start:=Selection.MoveStart(wdLine, 1),
End:=MyRange.End
MyRange.Collapse wdCollapseStart
Set StartRange = MyRange.Duplicate

With MyRange.Find
.Forward = True
.Wrap = wdFindStop
.Text = "[END"
.Replacement.Text = ""
.Execute

If .Found Then
''Extend the range from the found item back to the
start of the original range
MyRange.Start = StartRange.Start
MyRange.Select
Selection.MoveEnd Unit:=wdLine, Count:=-1
Set MyRange = Selection.Range

' do stuff here

End If
End With

Case "<s>"
' this is a small table. Need to find the first paragraph that
doesn't contain a tab mark.
Case Else

End Select

Loop

End Sub
Click to expand...
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Word macro that can call cells out of Excel for a find and replace 0
VBA to look for more than 1 key word and highlights 8
WORD VBA Search and switch to advanced ... 1
Macro duplicates last comment 2
Word Macro for multiple searches, incl. in footnotes 2
Where to place the Do 4
Trouble with Find and Replace vba routine 2
Will not Stop 3

Top