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

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!

Code:

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

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?

Code:

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

You might use something like:

Code:

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

Quote:

Originally Posted by macropod

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:

Code:

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

I found it. This

Code:

.Execute Replace:=wdReplaceOnce

should be this

Code:

.Execute Replace:=wdReplaceOne

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.

Quote:

Originally Posted by 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.

Oh wow! I'll have to study it closer in the morning.
THANKS for the reminder:bow:

Quote:

Originally Posted by 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.

I get it now. I'm good. I have other questions about FIND/REPLACE, but I'll open a new post for that.