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

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

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