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