How to extend selection,copy,paste in new doc, repeat

[Markus J]

This is a two part question from a full time vba newbie

The project:

We receive over 50 teacher reviews in one word document. We need to
search through this 100 page document and copy each teachers evaluation into
a new document. The only distinguishing feature between each teacher's
evaluation is the teachers name in 18pt font, which font size occurs no where
else in the document except by the teachers name.

My purposed solutions:

I was thinking of using this instance to extend the selector and
make the appropriate copies.

My problems:

1)I can't figure out how to extend the selector to a font.size
instance or use the range method to select the name by font size and add a
distinguishing character "*" before the teachers name so it can be selected
with selector.extend.
2) When I run the part of my code that copies each
selection.extend character:="*" and pastes it into a new word document,
closes and saves it, I can't seem to get the selector to unselect the last
selection and re-extend itself. I've toyed with deleting the last selection
to force it to copy the next and just not save the document when the process
is done but it only works for the first time through the loop.

My Code:

Sub CopyPasteSelection()


Dim msgStat As Long
msgStat = vbYes


Do While msgStat = vbYes

Selection.Extend Character:="*"
Selection.Copy
Documents.Add
ActiveWindow.ActivePane.LargeScroll Down:=1
Selection.PasteAndFormat (wdPasteDefault)

ActiveDocument.Save

ActiveWindow.Close
Selection.Delete

msgStat = MsgBox("Continue to the next step?", vbYesNo)

Loop

Documents.Close SaveChanges:=wdDoNotSaveChanges


End Sub




Notes:

I am VERY new at VBA and programming in general and would really
appreciate the help on this project. I'm sure it's something simple but
simple problems are still a mountain at this point.

 

[DaveLett]

Hi Markus,
This probably isn't the most efficient code, but I think it does what you're
looking for.

Dim oRng As Range
Dim oDocStart As Document
Dim oDoc As Document
Dim bLast As Boolean

Set oDocStart = ActiveDocument
bLast = False

With Selection
.HomeKey unit:=wdStory
With .Find
.ClearFormatting
.Text = ""
.Font.Size = 18
Do While .Execute
Set oRng = Selection.Range
oRng.MoveEnd unit:=wdParagraph, Count:=1
Do While oRng.Paragraphs(oRng.Paragraphs.Count).Range.Font.Size
<> 18
oRng.MoveEnd unit:=wdParagraph, Count:=1
If oRng.Paragraphs(oRng.Paragraphs.Count).Range =
ActiveDocument.Paragraphs.Last.Range Then
bLast = True
Exit Do
End If
Loop
If Not bLast Then
oRng.MoveEnd unit:=wdParagraph, Count:=-1
End If
Debug.Print oRng.Text
Set oDoc = Documents.Add
oDoc.Range.FormattedText = oRng.FormattedText

oDocStart.Activate
Selection.MoveRight

Loop
End With
End With

HTH,
Dave