Substitute Search ID - With Paragraph Ranges

[dj44]

Hello to all, :grinhalo:

I am needing some assistance on this macro gone wrong. I was trying to copy and paste some paragraphs in a document.




Example Find

CP123

Copy the corresponding paragraphs or ranges that starts with CP123 - and ends with xx

Delete the old paragraph ranges

Find

CP456

Copy paragraph that begins with CP456 and ends with xx.


I tried to put something together but dratted thing - wont start up




Sub CopyPasteParagraphs()

Dim oRng As Range
Dim FindText As String
Dim i As Long

With oRng.Find
Do While .Execute(FindText:="[CP]{3,}[0-9]{3,}",
MatchWildcards:=True)
On Error GoTo lbl_Exit

Do Until oRng.Next.Words(1) = "xx" ' or similar text

oRng.MoveEnd wdWord

Loop

oRng.End = oRng.End + 2


finding the Search ID now

FindText = FindText & oRng.Paragraphs(i).Range.Text
Next i

FindText = Replace(FindText, i, " ")

'Copy and paste range

Selection.Copy

Selection.TypeParagraph
Selection.PasteAndFormat (wdFormatOriginalFormatting)

End Sub




Gentlemen , Any pointers and your help really appreciated - :grinhalo:

many thanks
dj

[gmayor]

A little bit of knowledge is a dangerous thing :)
Where do we start? You have used oRng but not indicated what oRng is. You have referred to a label that doesn't exist and have used a search string that would never find the required string - see http://www.gmayor.com/replace_using_wildcards.htm at which point I gave up.

It seems that you want to replace paragraphs that begin with a particular text string with paragraphs that begin with a different text string, whilst retaining their formatting? In that case you first find the replacement string, as that must exist only once as far as the macro is concerned, then replace all paragraphs that start with the first string. The wildcards are unnecessary. You must search for the required strings. The following approach uses a sub that requires the search and replace strings to be provides as variables as shown in Macro1. You can call the main sub more than once for different search and replace strings:
Sub Macro1()
ReplaceParagraphs "CP123", "CP456"
lbl_Exit:
Exit Sub
End Sub

Sub ReplaceParagraphs(strFind As String, strReplace As String)
Dim oRng As Range
Dim oFind As Range
Set oRng = ActiveDocument.Range
Set oFind = ActiveDocument.Range
With oFind.Find
Do While .Execute(FindText:=strReplace)
If oFind.Start = oFind.Paragraphs(1).Range.Start Then
oFind.End = oFind.Paragraphs(1).Range.End
With oRng.Find
Do While .Execute(FindText:=strFind)
If oRng.Start = oRng.Paragraphs(1).Range.Start Then
oRng.End = oRng.Paragraphs(1).Range.End
oRng.FormattedText = oFind.FormattedText
End If
oRng.Collapse 0
Loop
End With
Exit Do
End If
Loop
End With
lbl_Exit:
Set oRng = Nothing
Set oFind = Nothing
Exit Sub
End Sub

[gmaxey]

Graham,
Unlike me, it appears that you endeavored to overcome. The OP also ended a For Next loop without ever starting it.

[dj44]

Graham,

thank you for this fine work :)

I can't figure out if i am running it wrong:old:

Lets say for example

*******************************

Find the Search string : CP123


Replace with paragraph range :

CP123 Lorem Ipsum is simply dummy text of the printing and typesetting industry. Lorem Ipsum has been the industry's standard dummy text ever since the 1500s, when an unknown printer took a galley of type and scrambled it to make a type specimen book. It has survived not only five centuries, but also the leap into electronic typesetting, remaining essentially unchanged. XX


Find the Search string : CP145


Replace with paragraph range :

CP145 Lorem Ipsum is simply dummy text of the printing and typesetting industry. Lorem Ipsum has been the industry's standard dummy text ever since the 1500s, when an unknown printer took a galley of type and scrambled it to make a type specimen book. It has survived not only five centuries, but also the leap into electronic typesetting, remaining essentially unchanged. XX




....Next paragraph job...ad infinitum

**************************

I ran the fine macro - but for some reason I did not get the replacement.

I also ran it as it - with changing the id's -

I hope you won't mind helping me run this

Thank you Graham:grinhalo:

DJ

[dj44]

Hello Greg,


Graham,
Unlike me, it appears that you endeavored to overcome. The OP also ended a For Next loop without ever starting it.


that for loop had a mind of its own - its predecessor made the great escape from me :grinhalo:



dj

[gmayor]

The original macro has CP123 replace with CP456. Did you change the CP456 to CP145?
Sub Macro1()
ReplaceParagraphs "CP123", "CP145"
lbl_Exit:
Exit Sub
End Sub
Do CP123 and CP145 actually begin paragraphs i.e. the document uses paragraph breaks '¶' not line breaks? Pasting from the forum has the latter, so it is necessary to replace ^l with ^p before running the macro if copying and pasting your sample text into Word.

Before running the macro you then have:
15397
After running the macro you should have the following. I coloured the replacement text red so you can see that there has been a change.
15396

[gmayor]

Duplicated in error :(

[dj44]

Hello Graham,

I understand the good work now - it worked to substitute the paragraphs as it said on the tin:grinhalo:

I must have got my wires crossed.

Now the below it's not an array is it where I can - store more than one set of replacements, i tried that and no will do.





Sub Macro1()
ReplaceParagraphs "CP123", "CP145"
lbl_Exit:
Exit Sub
End Sub



Also am I able to delete the previous range that I just substituted - I have 2 of the same paragraph now
I tried adding 1 line to delete the range - it wouldn't work

oRng.FormattedText = oFind.FormattedText
oRng.Delete


my gratitude for your help:)

DJ

[gmayor]

You can call the sub as many times as you have pairs e.g. as follows. Frankly it doesn't matter whether you use a loop or not. You still have to run the macro for each pair. This way it is obvious what you are replacing, so there are fewer opportunities for error.

Sub Macro1()
ReplaceParagraphs "CP123", "CP145"
ReplaceParagraphs "CP124", "CP521"
ReplaceParagraphs "CP166", "CP105"
ReplaceParagraphs "CP211", "CP142"
lbl_Exit:
Exit Sub
End Sub

I am not sure what it is you now want to delete. If it is the original text (here beginning CP145) that you want to delete, then add the line

oFind.Deleteto the main macro immediately before
lbl_Exit:

[dj44]

Graham,

thank you for pointing out how to kit out this fine macro.


The added suggestions - worked a treat:content:

Now not to take advantage of your good grace - but a final simple tweak I will need to work out how to add.

I just realized the paragraphs can be longer than 1 paragraph - hence initially I was trying to mark them off for with an end marker, the XX

I am fiddling about with something along these lines- but no will do




oFind.End = oFind.Paragraphs(1).Range.End

or

MoveUntil Cset:="XX"
oRng.End = oRng.Paragraphs(1).Range.End


or

Do Until oRng.Next.Words(1) = " XX"



bit stumped which one it is:confused:

thank you for all the help so far my great gratitude :thumb

DJ

[gmayor]

(B) is almost there, but it is the last paragraph of the range you want not the first. The following (which assumes XX for both find and replace paragraphs as in your sample) should work

Sub ReplaceParagraphs(strFind As String, strReplace As String)
Dim oRng As Range
Dim oFind As Range
Set oRng = ActiveDocument.Range
Set oFind = ActiveDocument.Range
With oFind.Find
Do While .Execute(FindText:=strReplace)
If oFind.Start = oFind.Paragraphs(1).Range.Start Then
oFind.MoveEndUntil "XX"
oFind.End = oFind.Paragraphs.Last.Range.End
With oRng.Find
Do While .Execute(FindText:=strFind)
If oRng.Start = oRng.Paragraphs(1).Range.Start Then
oRng.MoveEndUntil "XX"
oRng.End = oRng.Paragraphs.Last.Range.End
oRng.FormattedText = oFind.FormattedText
End If
oRng.Collapse 0
Loop
End With
Exit Do
End If
Loop
End With
lbl_Exit:
Set oRng = Nothing
Set oFind = Nothing
Exit Sub
End Sub

[dj44]

Graham,

you are a great man.:grinhalo:

Thanks for sticking through this copy paste paragraphs dilemma.

It's all sorted now thanks to your good help and wisdom.

I will have to be careful where I put the xx - lots of formatting problems in the docs, but at least i have a mighty helper :writer:

Copy and pasting is not the best use of time:old:

thanks for all the help again

you have a good sunday:beerchug:

DJ