How to find and rearrange texts in Word using VBA - vba

Question

i have recorded a macro where i remodel a text from .txt file. Ok, after that, what i want to do is to search for a key word, which will find some of this words in the text and then, to select 1 line upwards (always) and, this the tricky part where i couldn't find tips anywhere and why i'm here, the selection below varies and i dont know to set a way to stop. Select all the texts containing the key word and put them together, with the text structure, at end of the page or being able to copy those selected text to be able to paste in other document.
I'm inserting images before and after using the macro, to illustrate what it does and help understand what i need. As you can see, the kew words in this picture are "HAWK" and "OPGW", they are cables used to build electric power transmission lines. Where one line above refers to the start and end structure to which the "HAWK" or "OPGW" cable is attached to, and for the lines below these key words, it refers to the tension loads submitted and etc..., That's why the variation of lines.
I'm attatching bellow my code which remodels the .txt. I had to cut the middle part of my code, because it was so huge, insanely huge.. we have 5 computers here, so i had to replace the text ".Text = "Cable 'C:\users\XXXX..." for each directory accessed by each computer, that's why is so big haha.
I am a newbie at codding, so i would like your guidance if possible.
Thanks in advance for any help you may provide!
The text from .txt file
The text from .txt file after using the macro
Sub VM_tabestic3()
Dim StartWord As String, EndWord As String
Dim Find1stRange As Range, FindEndRange As Range
Dim DelRange As Range, DelStartRange As Range, DelEndRange As Range
Set Find1stRange = ActiveDocument.Range
Set FindEndRange = ActiveDocument.Range
Set DelRange = ActiveDocument.Range
StartWord = "PLS-CADD Version"
EndWord = "Stringing Chart Report"
With Find1stRange.Find
.Text = StartWord
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
Do While .Execute
If .Found = True Then
Set DelStartRange = Find1stRange
DelStartRange.Select
FindEndRange.Start = DelStartRange.End
FindEndRange.End = ActiveDocument.Content.End
FindEndRange.Select
With FindEndRange.Find
.Text = EndWord
.Execute
If .Found = True Then
Set DelEndRange = FindEndRange
DelEndRange.Select
End If
End With
DelRange.Start = DelStartRange.Start
DelRange.End = DelEndRange.End
DelRange.Select
DelRange.Delete
End If
Loop
End With
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Stringing Chart Report"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Section #^?^?"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "from structure"
.Replacement.Text = "Est. inicial"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = " to structure"
.Replacement.Text = " Est. final"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.Replacement.Font.Bold = False
With Selection.Find
.Text = "Cable 'C:\Users\Usuario\ENGETRAN ENGENHARIA DE SISTEMAS DE TRANSMISSAO\Engetran - Documentos\Projetos\#Projeto Modelo\PLSCADD\Cabos Condutores\CA\1113_0-marigold.wir'"
.Replacement.Text = "Cabo Condutor: CA MARIGOLD"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "Cable '\\brasil\g\PUBLICA\pls2\Bibliote\Cabos_2009\condutor\starling_acsr.wir'"
.Replacement.Text = "Cabo Condutor: CAA STARLING "
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "Cable '\\brasil\g\PUBLICA\pls2\Bibliote\Cabos_2009\condutor\T-caa_T-rail'"
.Replacement.Text = "Cabo Condutor: T-CAA T-RAIL"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "Cable '\\brasil\g\PUBLICA\pls2\Bibliote\Cabos_2009\condutor\tern_acsr.wir'"
.Replacement.Text = "Cabo Condutor: CAA TERN"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "Cable '\\brasil\g\PUBLICA\pls2\Bibliote\Cabos_2009\condutor\violet_aac - Cópia.wir'"
.Replacement.Text = "Cabo Condutor: CA VIOLET"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "Cable '\\brasil\g\PUBLICA\pls2\Bibliote\Cabos_2009\condutor\violet_aac.wir'"
.Replacement.Text = "Cabo Condutor: CA VIOLET "
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.Replacement.Font.Bold = False
With Selection.Find
.Text = "Cable '\\brasil\g\publica\pls2\bibliote\cabos_2009\condutor\"
.Replacement.Text = "Cabo Condutor: "
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "Cable '\\brasil\g\publica\pls2\bibliote\cabos_2009\pararaio\"
.Replacement.Text = "Cabo Para-raios: "
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Ruling span"
.Replacement.Text = "Vão regulador"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "Sagging data: Catenary"
.Replacement.Text = "Dados de flechamento: Catenária"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "Condition I Temperature (deg C)"
.Replacement.Text = "C. Inicial, Temp. (°C)"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "Condition C Temperature (deg C)"
.Replacement.Text = "C. Inicial, Temp. (°C)"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "Results below for condition 'Initial RS'"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = _
"Calculations done using actual span lengths and vertical projections"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = " Span Mid Mid"
.Replacement.Text = " Mid Mid"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "Length"
.Replacement.Text = " Vão"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "Results below for condition='I'"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "Mid"
.Replacement.Text = " "
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "Span"
.Replacement.Text = " "
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = " Sag "
.Replacement.Text = "Flecha"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = " Left "
.Replacement.Text = " Suporte"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "Vertical"
.Replacement.Text = " "
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "Projection"
.Replacement.Text = " Desnível"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "Horiz"
.Replacement.Text = " "
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "Tension"
.Replacement.Text = "Tração "
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "Struct"
.Replacement.Text = " Ré "
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "Number"
.Replacement.Text = " N° "
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
ActiveDocument.Select
Selection.WholeStory
Selection.Font.Name = "Courier New"
Selection.Font.Size = 8
ActiveDocument.Range.Find.Execute FindText:=" Est. inicial", ReplaceWith:="Est. inicial", Replace:=wdReplaceAll
ActiveDocument.Range.Find.Execute FindText:="^m", ReplaceWith:="^p", Replace:=wdReplaceAll
ActiveDocument.Range.Find.Execute FindText:="^p^p", ReplaceWith:="^p", Replace:=wdReplaceAll
ActiveDocument.Range.Find.Execute FindText:=", .", ReplaceWith:=",", Replace:=wdReplaceAll
ActiveDocument.Range.Find.Execute FindText:=" (N)", ReplaceWith:=" (N)", Replace:=wdReplaceAll
ActiveDocument.Range.Find.Execute FindText:=", Temp.", ReplaceWith:=", Temp.", Replace:=wdReplaceAll
ActiveDocument.Range.Find.Execute FindText:=" C. Inicial", ReplaceWith:=", C. Inicial", Replace:=wdReplaceAll
ActiveDocument.Range.Find.Execute FindText:="start", ReplaceWith:="^p", Replace:=wdReplaceAll
ActiveDocument.Range.Find.Execute FindText:="^p^p^p^p", ReplaceWith:="^p^p", Replace:=wdReplaceAll
ActiveDocument.Range.Find.Execute FindText:=" Est. f", ReplaceWith:=" - Est. f", Replace:=wdReplaceAll
Dim check As Boolean
Dim search As String
Dim para As Paragraph
Dim tempStr As String
Dim txt As String
search = "set"
For Each para In ActiveDocument.Paragraphs
txt = para.Range.Text
tempStr = LCase(txt)
check = InStr(tempStr, search)
If check = True Then
para.Range.Delete
End If
Next
ActiveDocument.Range.Find.Execute FindText:="Est. i", ReplaceWith:="$ Est. i", Replace:=wdReplaceAll
ActiveDocument.Range.Find.Execute FindText:=", ^p", ReplaceWith:=", $ ^p", Replace:=wdReplaceAll
ActiveDocument.Range.Find.Execute FindText:="Section ^?^?", ReplaceWith:="", Replace:=wdReplaceAll
ActiveDocument.Range.Find.Execute FindText:=" Est. inicial", ReplaceWith:="Est. inicial", Replace:=wdReplaceAll
ActiveDocument.Range.Find.Execute FindText:="^p^p^p^p", ReplaceWith:="^p^p", Replace:=wdReplaceAll
ActiveDocument.Range.Find.Execute FindText:="^p^p^p", ReplaceWith:="^p^p", Replace:=wdReplaceAll
ActiveDocument.Range.Find.Execute FindText:="Est. inicial", ReplaceWith:="^pEst. inicial", Replace:=wdReplaceAll
ActiveDocument.Range.Find.Execute FindText:=" Desnível", ReplaceWith:="Desnível", Replace:=wdReplaceAll
ActiveDocument.Range.Find.Execute FindText:=" (N) (N) (N) (N) (N) (N) (N)", ReplaceWith:=" (N) (N) (N) (N) (N) (N) (N) ", Replace:=wdReplaceAll
Set myRange = ActiveDocument.Content
Dim oRng As Word.Range
Set oRng = ActiveDocument.Range
With oRng.Find
.Text = "$*$"
.MatchWildcards = True
While .Execute
oRng.Words.First.Delete
oRng.Words.Last.Delete
oRng.Bold = True
oRng.InsertBefore ""
oRng.InsertAfter ""
oRng.Characters.Last.Bold = False
oRng.Collapse wdCollapseEnd
Wend
End With
lbl_Exit:
Exit Sub
End Sub

Answer 1

This is not an answer. The Asker has requested an example of how to implement my suggestions.
Currently, the code is written like this:
Sub Example()
With Selection.Find
.Text = "A"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "B"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "C"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
That is 41 lines of code (not counting blank lines) and would take an additional 13 lines of code for each new Find & Replace item.
Instead of repeating this code block for each item, create a sub like this:
Sub CustomFindReplace(FindWithin As Object, FindText As String, Optional ReplaceText As String = "")
With FindWithin.Find
.Text = FindText
.Replacement.Text = ReplaceText
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
FindWithin.Find.Execute Replace:=wdReplaceAll
End Sub
Then your main program can be shortened:
Sub Example2()
CustomFindReplace Selection, FindText:="A", ReplaceText:="X"
CustomFindReplace Selection, FindText:="B", ReplaceText:="Y"
CustomFindReplace Selection, FindText:="C", ReplaceText:="Z"
End Sub
Now instead of 41 lines, we are down to 5 lines of code. Each new item will add one line of code.