Find Variable From Array - Copy Insert Previous Range as a New Paragraph

[dj44]

folks,

good day,

i have got stuck on my loop, i managed to do the hard bit putting it togther, but now the simple bit i cant do


Find the numbers
move untill Double qoute
copy that
Insert as a new paragraph previous above it







Sub InsertRange()


Dim oRng As Word.Range
Dim arrWords As Variant
Dim oReplace As Variant
Dim i As Long, j As Long


arrWords = Array("05_", "06_", "07_", "08_", "09_")

For i = 0 To UBound(arrWords)
Set oRng = ActiveDocument.Range
j = 0
With oRng.Find
Do While .Execute(FindText:=arrWords(i), MatchWholeWord:=True)


If .Found Then



oRng.MoveEndUntil Cset:="""", Count:=wdForward 'Move untill Double Quotes


oRng.Copy ' Copy it


'oRng.MoveStart ' Insert as a new paragraph before it

oRng.Previous.Range.InsertBefore vbNewLine & oRng & vbNewLine




'----------------
j = j + 1

End If
oRng.Collapse 0

If j = 1 Then Exit Do 'Number of times you want to replace



Loop
End With
Next i
Set oRng = Nothing



End Sub





Before

France
"05_Aruba is great"
Croatia
Bulgaria
"06_Germany is great"
Tuvalu
Armenia


After


France

05_Aruba
"05_Aruba is great"

Croatia
Bulgaria

06_Germany
"06_Germany is great"
Tuvalu
Armenia


thank you for any advice

[gmaxey]

What is the point of a Do ... Loop if you are hard coding to exit after the first execution? Why add empty paragraphs to a document?


Sub InsertRange()
Dim oRng As Range
Dim arrWords As Variant
Dim lngIndex As Long
arrWords = Array("05_", "06_", "07_", "08_", "09_")
For lngIndex = 0 To UBound(arrWords)
Set oRng = ActiveDocument.Range
With oRng.Find
If .Execute(FindText:=arrWords(lngIndex), MatchWholeWord:=True) Then
If oRng.Characters.First.Previous = """" And _
oRng.Characters.First.Previous.Previous = Chr(13) Then
oRng.Paragraphs(1).Previous.SpaceAfter = 12
End If
End If
End With
Set oRng = Nothing
Next lngIndex
lbl_Exit:
Exit Sub
End Sub

[dj44]

Hello Greg
nice to see you :)

Oops I think I probably didn't explain it as good as I should have.

I just simply want to duplicate the first time it finds one of the array words and insert it as a new paragraph above

Oh yes so that other loop that exited was the counter

Oh and sorry about the empty paragraphs that was me just being messy I forgot how explicit you have to be with coding instructions :doh:

I was able to copy the range
But I got stuck on inserting it as a new paragraph


Before

France
"05_Aruba is great"
Croatia
Bulgaria
"06_Germany is great"
Tuvalu
Armenia
"05_Cannes" <<< DONT DUPLICATE this paragraph
New Zealand
"06_Thailand" << Second instance -dont duplicate


After
France
05_Aruba is great << Yes New paragraph
"05_Aruba is great"
Croatia
Bulgaria
06_Germany is great << Yes
"06_Germany is great"
Tuvalu
Armenia
"05_Cannes"
New Zealand
"06_Thailand"

....



I couldnt work out how to insert my copied range, becuase i tried

oRng.previous.paragraphs

ok let me try again

thank you

[gmaxey]

Sub InsertRange()
Dim oRng As Range, oRngReplicate As Range
Dim arrWords As Variant
Dim lngIndex As Long
arrWords = Array("05_", "06_", "07_", "08_", "09_")
For lngIndex = 0 To UBound(arrWords)
Set oRng = ActiveDocument.Range
With oRng.Find
If .Execute(FindText:=arrWords(lngIndex), MatchWholeWord:=True) Then
If oRng.Characters.First.Previous = """" And _
oRng.Characters.First.Previous.Previous = Chr(13) Then
oRng.Start = oRng.Paragraphs(1).Range.Start
oRng.InsertBefore oRng.Paragraphs(1).Range.Text
Set oRngReplicate = oRng.Paragraphs(1).Range
oRngReplicate.Characters(1).Delete
oRngReplicate.Characters.Last.Previous.Delete
End If
End If
End With
Set oRng = Nothing
Next lngIndex
lbl_Exit:
Exit Sub
End Sub

[dj44]

Thank you for the help Greg,

somethings happened to my range

Theres some wierd characters appeared out of nowhere now.

I will have to investigate my document and report back later
:)

[dj44]

Crises Averted

 ’s

somethings like the above appeared, i did a copy and replace to get back my normal text

Well i dont know why microsoft added those for no reason out of the blue :doh:

I was able to add 2 lines as well to make it happen
oRng.Expand Unit:=wdParagraph
oRng.Collapse wdCollapseStart

Thank you for the help Greg,

And good evening and friday and weekend Greg and all

:)