Copy, format, paste inline - I must be missing something fundamental

[o1sowise]

I've Selected a section of text in a Word doc. I'm trying to copy the text, reformat it and regurgitate it back inline, after the original selection. I'm having trouble getting the code to work repeatedly.

For example, if the source said:
This is a source line. It’s a very nice source line of text.

I’d like the result to be:
This is a source line. It’s a very nice source line of text.
This is a source line. It’s a very nice source line of text.


I’d like to build on it later to do some FIND/REPLACE logic, but right now, I’d be happy if I can just get the new 2nd line to appear (using Style=Answer) immediately after the 1st line.

I've tried a few different ways of doing this, as you can see by the attached code fragments. Sometimes it works, sometimes it changes the following sentence, not the one selected. I must be missing something fundamental! Any insight would be greatly appreciated!



Sub Macro1()
Selection.Copy
Selection.TypeParagraph
Selection.PasteAndFormat (wdFormatOriginalFormatting)
Selection.Style = ActiveDocument.Styles("Answer")
Selection.ParagraphFormat.Alignment = wdAlignParagraphJustify
End Sub
Sub Macro2()
Selection.Copy
Selection.TypeParagraph
Selection.PasteAndFormat wdListDontMerge
Selection.Style = ActiveDocument.Styles("Answer")
Selection.ParagraphFormat.Alignment = wdAlignParagraphJustify
End Sub
Sub Macro4()
Selection.Copy
Selection.Collapse Direction:=wdCollapseEnd
Selection.Move wdSentence, 1
Selection.Style = ActiveDocument.Styles("Answer")
Selection.PasteSpecial Link:=False, DataType:=wdPasteText, Placement:=wdInLine, DisplayAsIcon:=False
End Sub
Sub Macro5()

With Selection
.Copy
.Move Unit:=wdParagraph
' .InsertParagraphAfter
' .Collapse Direction:=wdCollapseStart
' .PasteAndFormat (wdFormatOriginalFormatting)
.PasteAndFormat wdListDontMerge
.Style = ActiveDocument.Styles("Answer")
.ParagraphFormat.Alignment = wdAlignParagraphJustify

End With

End Sub

[o1sowise]

I almost have it! The last line of code doesn't really work. When I'm selecting an item from a numbered list, it creates a new numbered list inline. Is there a way to COPY or PASTE and drop the list-ness?

Sub Macro4()
If Selection.Type = wdSelectionIP Then
MsgBox "Nothing is selected." & vbCrLf & "Select something and try again.", vbCritical, "Regurgitate Macro"
Else
Debug.Print Selection.Characters.count
Selection.Copy
Selection.Collapse Direction:=wdCollapseEnd
Selection.TypeParagraph
Selection.Move wdCharacter, -1
Selection.Style = ActiveDocument.Styles("Answer")
Selection.PasteSpecial Link:=False, DataType:=wdPasteText, Placement:=wdInLine, DisplayAsIcon:=False
Selection.Range.ListFormat.RemoveNumbers NumberType:=wdNumberParagraph
End If
End Sub

[macropod]

You might use something like:

Sub Demo()
Application.ScreenUpdating = False
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = InputBox("What is the Text to Find") & "^p"
.Replacement.Text = "^&^&"
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
End With
Do While .Find.Found
.Paragraphs.Last.Range.Style = "Strong"
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
Application.ScreenUpdating = True
End Sub
Note: The inputbox takes ordinary text but the code assumes it applies to a whole paragraph

[o1sowise]

Your FIND code

Thanks Paul!

My problem now is that I can either get the COPY code to work or the FIND code. I cannot get them to work together.

As you know, I want to:

duplicate the selected line,
then change the attributes of the newly duplicated line,
then FIND/REPLACE in the newly duplicated line.

The code I've shown here does almost all of the above. It does 2.5 of the above. It stops at the FIND, selects the thing to change, but doesn't change it. :think:

Here's what I have:

Sub Regurgitate()

If Selection.Type = wdSelectionIP Then
MsgBox "Nothing is selected." & vbCrLf & "Select something and try again.", vbCritical, "Regurgitate Macro"
Else
Debug.Print Selection.Characters.count

With Selection
.Copy
.Collapse Direction:=wdCollapseEnd
.TypeParagraph
.Move wdCharacter, -1

' Selection.Style = ActiveDocument.Styles("Answer")
.Font.ColorIndex = wdBlue

.PasteSpecial Link:=False, DataType:=wdPasteText, Placement:=wdInLine, DisplayAsIcon:=False
.Move wdSentence, -1
With .Find
.ClearFormatting
.Text = "Contractor"
With .Replacement
.Text = "?????"
.ClearFormatting
' .Highlight = True
.Font.Bold = True
' .Font.Color = vbRed
End With
.Forward = True
.Format = True
.Wrap = wdFindStop
' .Wrap = wdFindContinue
.MatchCase = True
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=wdReplaceonce

If .Found = True Then .Replacement.Font.Bold = True
End With
.Range.ListFormat.RemoveNumbers NumberType:=wdNumberParagraph
End With

End If
End Sub

[o1sowise]

I found it. This

.Execute Replace:=wdReplaceOnce
should be this

.Execute Replace:=wdReplaceOne

[macropod]

If you study the code I posted, you'll see there is no need for any copy/paste. The entire replication is taken care of by the Find/Replace. The application of any attributes is taken care of within the Do While loop.

[o1sowise]

If you study the code I posted, you'll see there is no need for any copy/paste. The entire replication is taken care of by the Find/Replace. The application of any attributes is taken care of within the Do While loop.Oh wow! I'll have to study it closer in the morning.
THANKS for the reminder:bow:

[o1sowise]

If you study the code I posted, you'll see there is no need for any copy/paste. The entire replication is taken care of by the Find/Replace. The application of any attributes is taken care of within the Do While loop.I get it now. I'm good. I have other questions about FIND/REPLACE, but I'll open a new post for that.