Find, Cut, then Paste Methodology

I have a number of documents that have questions in one part of a document
and the corresponding answers in another part of the document. I need to
modify the document to have the answer four lines after the associated
question.

I need to be able to:
1) loop through the document,
2) find "question 1",
3) go down 4 lines and mark that location as the place to paste "answer 1",
4) then find "answer 1",
5) cut "answer 1" and paste in the new location for "answer 1".
6) loop to the next question number.

Can anyone help me get started?

Thanks in advance,
Raul

Chuck
Tue Apr 05 10:31:03 CDT 2005

Try this:

Sub FindQandA()

Dim i As Long
Dim rngSource As Range
Dim rngTarget As Range
Dim docSource As Document
Dim docTarget As Document

i = 0
strQText = "Question " & CStr(i)

Set docSource = ActiveDocument
Set docTarget = Documents.Add

Do
Set rngSource = docSource.Range
i = i + 1
With rngSource.Find
.Text = "Question " & CStr(i)
If .Execute Then
With rngSource
.Expand wdParagraph
Set rngTarget = docTarget.Range
rngTarget.Collapse wdCollapseEnd
rngTarget.Text = rngSource.Text & _
vbNewLine & _
vbNewLine & _
vbNewLine & _
vbNewLine
Set rngSource = docSource.Range
With rngSource.Find
.Text = "Answer " & CStr(i)
.Execute
With rngSource
.Expand wdParagraph
Set rngTarget = docTarget.Range
rngTarget.Collapse wdCollapseEnd
rngTarget.Text = rngSource.Text & _
vbNewLine & _
vbNewLine & _
vbNewLine & _
vbNewLine
End With
End With
End With
Else
Exit Do
End If
End With
Loop

Set docSource = Nothing
Set docTarget = Nothing

End Sub


"Raul" wrote:

> I have a number of documents that have questions in one part of a document
> and the corresponding answers in another part of the document. I need to
> modify the document to have the answer four lines after the associated
> question.
>
> I need to be able to:
> 1) loop through the document,
> 2) find "question 1",
> 3) go down 4 lines and mark that location as the place to paste "answer 1",
> 4) then find "answer 1",
> 5) cut "answer 1" and paste in the new location for "answer 1".
> 6) loop to the next question number.
>
> Can anyone help me get started?
>
> Thanks in advance,
> Raul

raul
Tue Apr 05 14:31:08 CDT 2005

This is really great.

Thanks,
Raul

"Chuck" wrote:

> Try this:
>
> Sub FindQandA()
>
> Dim i As Long
> Dim rngSource As Range
> Dim rngTarget As Range
> Dim docSource As Document
> Dim docTarget As Document
>
> i = 0
> strQText = "Question " & CStr(i)
>
> Set docSource = ActiveDocument
> Set docTarget = Documents.Add
>
> Do
> Set rngSource = docSource.Range
> i = i + 1
> With rngSource.Find
> .Text = "Question " & CStr(i)
> If .Execute Then
> With rngSource
> .Expand wdParagraph
> Set rngTarget = docTarget.Range
> rngTarget.Collapse wdCollapseEnd
> rngTarget.Text = rngSource.Text & _
> vbNewLine & _
> vbNewLine & _
> vbNewLine & _
> vbNewLine
> Set rngSource = docSource.Range
> With rngSource.Find
> .Text = "Answer " & CStr(i)
> .Execute
> With rngSource
> .Expand wdParagraph
> Set rngTarget = docTarget.Range
> rngTarget.Collapse wdCollapseEnd
> rngTarget.Text = rngSource.Text & _
> vbNewLine & _
> vbNewLine & _
> vbNewLine & _
> vbNewLine
> End With
> End With
> End With
> Else
> Exit Do
> End If
> End With
> Loop
>
> Set docSource = Nothing
> Set docTarget = Nothing
>
> End Sub
>
>
> "Raul" wrote:
>
> > I have a number of documents that have questions in one part of a document
> > and the corresponding answers in another part of the document. I need to
> > modify the document to have the answer four lines after the associated
> > question.
> >
> > I need to be able to:
> > 1) loop through the document,
> > 2) find "question 1",
> > 3) go down 4 lines and mark that location as the place to paste "answer 1",
> > 4) then find "answer 1",
> > 5) cut "answer 1" and paste in the new location for "answer 1".
> > 6) loop to the next question number.
> >
> > Can anyone help me get started?
> >
> > Thanks in advance,
> > Raul

raul
Tue Apr 05 17:01:01 CDT 2005

This procedure worked beautifully.

Not to be too greedy, but Is there a way to modify this code to select the
paragraph that starts with Answer 1 as well as the following four paragraphs?

Thanks,
Raul

"Chuck" wrote:

> Try this:
>
> Sub FindQandA()
>
> Dim i As Long
> Dim rngSource As Range
> Dim rngTarget As Range
> Dim docSource As Document
> Dim docTarget As Document
>
> i = 0
> strQText = "Question " & CStr(i)
>
> Set docSource = ActiveDocument
> Set docTarget = Documents.Add
>
> Do
> Set rngSource = docSource.Range
> i = i + 1
> With rngSource.Find
> .Text = "Question " & CStr(i)
> If .Execute Then
> With rngSource
> .Expand wdParagraph
> Set rngTarget = docTarget.Range
> rngTarget.Collapse wdCollapseEnd
> rngTarget.Text = rngSource.Text & _
> vbNewLine & _
> vbNewLine & _
> vbNewLine & _
> vbNewLine
> Set rngSource = docSource.Range
> With rngSource.Find
> .Text = "Answer " & CStr(i)
> .Execute
> With rngSource
> .Expand wdParagraph
> Set rngTarget = docTarget.Range
> rngTarget.Collapse wdCollapseEnd
> rngTarget.Text = rngSource.Text & _
> vbNewLine & _
> vbNewLine & _
> vbNewLine & _
> vbNewLine
> End With
> End With
> End With
> Else
> Exit Do
> End If
> End With
> Loop
>
> Set docSource = Nothing
> Set docTarget = Nothing
>
> End Sub
>
>
> "Raul" wrote:
>
> > I have a number of documents that have questions in one part of a document
> > and the corresponding answers in another part of the document. I need to
> > modify the document to have the answer four lines after the associated
> > question.
> >
> > I need to be able to:
> > 1) loop through the document,
> > 2) find "question 1",
> > 3) go down 4 lines and mark that location as the place to paste "answer 1",
> > 4) then find "answer 1",
> > 5) cut "answer 1" and paste in the new location for "answer 1".
> > 6) loop to the next question number.
> >
> > Can anyone help me get started?
> >
> > Thanks in advance,
> > Raul

Chuck
Wed Apr 06 05:13:02 CDT 2005

BTW that line strQTest =... isn't necessary, it's left over from something
else.

"Raul" wrote:

> This procedure worked beautifully.
>
> Not to be too greedy, but Is there a way to modify this code to select the
> paragraph that starts with Answer 1 as well as the following four paragraphs?
>
> Thanks,
> Raul
>
> "Chuck" wrote:
>
> > Try this:
> >
> > Sub FindQandA()
> >
> > Dim i As Long
> > Dim rngSource As Range
> > Dim rngTarget As Range
> > Dim docSource As Document
> > Dim docTarget As Document
> >
> > i = 0
> > strQText = "Question " & CStr(i)
> >
> > Set docSource = ActiveDocument
> > Set docTarget = Documents.Add
> >
> > Do
> > Set rngSource = docSource.Range
> > i = i + 1
> > With rngSource.Find
> > .Text = "Question " & CStr(i)
> > If .Execute Then
> > With rngSource
> > .Expand wdParagraph
> > Set rngTarget = docTarget.Range
> > rngTarget.Collapse wdCollapseEnd
> > rngTarget.Text = rngSource.Text & _
> > vbNewLine & _
> > vbNewLine & _
> > vbNewLine & _
> > vbNewLine
> > Set rngSource = docSource.Range
> > With rngSource.Find
> > .Text = "Answer " & CStr(i)
> > .Execute
> > With rngSource
> > .Expand wdParagraph
> > Set rngTarget = docTarget.Range
> > rngTarget.Collapse wdCollapseEnd
> > rngTarget.Text = rngSource.Text & _
> > vbNewLine & _
> > vbNewLine & _
> > vbNewLine & _
> > vbNewLine
> > End With
> > End With
> > End With
> > Else
> > Exit Do
> > End If
> > End With
> > Loop
> >
> > Set docSource = Nothing
> > Set docTarget = Nothing
> >
> > End Sub
> >
> >
> > "Raul" wrote:
> >
> > > I have a number of documents that have questions in one part of a document
> > > and the corresponding answers in another part of the document. I need to
> > > modify the document to have the answer four lines after the associated
> > > question.
> > >
> > > I need to be able to:
> > > 1) loop through the document,
> > > 2) find "question 1",
> > > 3) go down 4 lines and mark that location as the place to paste "answer 1",
> > > 4) then find "answer 1",
> > > 5) cut "answer 1" and paste in the new location for "answer 1".
> > > 6) loop to the next question number.
> > >
> > > Can anyone help me get started?
> > >
> > > Thanks in advance,
> > > Raul

Chuck
Wed Apr 06 05:13:03 CDT 2005

Instead of .Expand you can also use .MoveEnd to extend the range. .MoveEnd
takes two arguments, the kind of move (character, paragraph, etc) and the
count (1, 2, 3 etc):

Sub FindQandA()

Dim i As Long
Dim rngSource As Range
Dim rngTarget As Range
Dim docSource As Document
Dim docTarget As Document

i = 0
strQText = "Question " & CStr(i)

Set docSource = ActiveDocument
Set docTarget = Documents.Add

Do
Set rngSource = docSource.Range
i = i + 1
With rngSource.Find
.Text = "Question " & CStr(i)
If .Execute Then
With rngSource
.MoveEnd wdParagraph, 1
Set rngTarget = docTarget.Range
rngTarget.Collapse wdCollapseEnd
rngTarget.Text = rngSource.Text & _
vbNewLine & _
vbNewLine & _
vbNewLine & _
vbNewLine
Set rngSource = docSource.Range
With rngSource.Find
.Text = "Answer " & CStr(i)
.Execute
With rngSource
.MoveEnd wdParagraph, 4
Set rngTarget = docTarget.Range
rngTarget.Collapse wdCollapseEnd
rngTarget.Text = rngSource.Text & _
vbNewLine & _
vbNewLine & _
vbNewLine & _
vbNewLine
End With
End With
End With
Else
Exit Do
End If
End With
Loop

Set docSource = Nothing
Set docTarget = Nothing

End Sub

raul
Wed Apr 06 07:15:02 CDT 2005

Chuck,
This worked like a charm; .MoveEnd did the trick.
I realy appreciate your writing this for me.

Thanks again,
Raul

"Chuck" wrote:

> BTW that line strQTest =... isn't necessary, it's left over from something
> else.
>
> "Raul" wrote:
>
> > This procedure worked beautifully.
> >
> > Not to be too greedy, but Is there a way to modify this code to select the
> > paragraph that starts with Answer 1 as well as the following four paragraphs?
> >
> > Thanks,
> > Raul
> >
> > "Chuck" wrote:
> >
> > > Try this:
> > >
> > > Sub FindQandA()
> > >
> > > Dim i As Long
> > > Dim rngSource As Range
> > > Dim rngTarget As Range
> > > Dim docSource As Document
> > > Dim docTarget As Document
> > >
> > > i = 0
> > > strQText = "Question " & CStr(i)
> > >
> > > Set docSource = ActiveDocument
> > > Set docTarget = Documents.Add
> > >
> > > Do
> > > Set rngSource = docSource.Range
> > > i = i + 1
> > > With rngSource.Find
> > > .Text = "Question " & CStr(i)
> > > If .Execute Then
> > > With rngSource
> > > .Expand wdParagraph
> > > Set rngTarget = docTarget.Range
> > > rngTarget.Collapse wdCollapseEnd
> > > rngTarget.Text = rngSource.Text & _
> > > vbNewLine & _
> > > vbNewLine & _
> > > vbNewLine & _
> > > vbNewLine
> > > Set rngSource = docSource.Range
> > > With rngSource.Find
> > > .Text = "Answer " & CStr(i)
> > > .Execute
> > > With rngSource
> > > .Expand wdParagraph
> > > Set rngTarget = docTarget.Range
> > > rngTarget.Collapse wdCollapseEnd
> > > rngTarget.Text = rngSource.Text & _
> > > vbNewLine & _
> > > vbNewLine & _
> > > vbNewLine & _
> > > vbNewLine
> > > End With
> > > End With
> > > End With
> > > Else
> > > Exit Do
> > > End If
> > > End With
> > > Loop
> > >
> > > Set docSource = Nothing
> > > Set docTarget = Nothing
> > >
> > > End Sub
> > >
> > >
> > > "Raul" wrote:
> > >
> > > > I have a number of documents that have questions in one part of a document
> > > > and the corresponding answers in another part of the document. I need to
> > > > modify the document to have the answer four lines after the associated
> > > > question.
> > > >
> > > > I need to be able to:
> > > > 1) loop through the document,
> > > > 2) find "question 1",
> > > > 3) go down 4 lines and mark that location as the place to paste "answer 1",
> > > > 4) then find "answer 1",
> > > > 5) cut "answer 1" and paste in the new location for "answer 1".
> > > > 6) loop to the next question number.
> > > >
> > > > Can anyone help me get started?
> > > >
> > > > Thanks in advance,
> > > > Raul