When I search without specifying the range, the search starts at the active page:
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "house"
.Replacement.Text = "apartment"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = True
End With
Selection.Find.Execute
If I use a range, it always starts at the beginning of the range
ActiveDocument.StoryRanges(wdMainTextStory).select
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "house"
.Replacement.Text = "apartment"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = True
End With
Selection.Find.Execute
Anyone know a way to start the search in the active page while using a range?
By active page, I mean the page with the cursor.
Also, I need to search footnotes and endnotes. That's the reason for using storyranges, which seems to force the search to start at the beginning of the document.
For example:
Dim findRange As Range
Set findRange = Selection.Range
With findRange.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "house"
.Replacement.Text = "apartment"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = True
.Execute
End With
Please note that as you have set .Wrap = wdFindContinue it makes no difference where Find starts as it will search the entire document anyway.
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
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.
i have a collection of working codes, that removes words from a word table, and reformats the size of the table. I know i'm repeating, in the code, so i'd like to make this more streamlined, and in the hope that by doing this, the code will become a little quicker to run.
I'm a complete noob to vba, so I've scoured the web, and ad-hocced the working code together. The table im working on is 150 rows, by 10 columns, but the rows will change on a weekly basis.
Option Explicit
Sub alterRota()
Dim manager
manager = "Manager"
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = manager
.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
Dim bar
bar = "Bar"
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = bar
.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
Dim kitchen
kitchen = "Kitchen"
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = kitchen
.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
Dim lead
lead = "Lead"
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = lead
.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
Dim cleaning
cleaning = "Cleaning"
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = cleaning
.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
Dim floor
floor = "Floor"
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = floor
.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
Dim timeoff
timeoff = "Time Off"
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = timeoff
.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
Dim startoff
startoff = "04:00 - 00:00"
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = startoff
.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
Dim endoff
endoff = "00:00 - 04:00"
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = endoff
.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
Dim linebreaks
linebreaks = "^p"
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = linebreaks
.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
Dim employee
employee = "Employee"
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = employee
.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
Dim tr As Row
For Each tr In ActiveDocument.Tables(1).Rows
tr.HeightRule = wdRowHeightExactly
tr.Height = 9
Next tr
End Sub
Your code can be re-written as follows...
Option Explicit
Sub alterRota()
Dim searchFor As Variant
searchFor = Array("Manager", "Bar", "Kitchen", . . . ) 'add your other words accordingly
Dim i As Long
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
For i = LBound(searchFor) To UBound(searchFor)
.Text = searchFor(i)
.Replacement.Text = ""
.Execute Replace:=wdReplaceAll
Next i
End With
Dim tr As Row
For Each tr In ActiveDocument.Tables(1).Rows
tr.HeightRule = wdRowHeightExactly
tr.Height = 9
Next tr
End Sub
I have recorded a macro to replace any bullet character (PS: Not bullet lists) with Standard bullet character (^0149).
Sub Macro1()
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "o^t"
.Replacement.Text = "^0149^t"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchKashida = False
.MatchDiacritics = False
.MatchAlefHamza = False
.MatchControl = 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 = ChrW(61607) & "^t"
.Replacement.Text = "^0149^t"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchKashida = False
.MatchDiacritics = False
.MatchAlefHamza = False
.MatchControl = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
My problem is some bullet characters not find. For an example please see below image.
How do I find any bullet character or any character by MS Word macro?
Not tested, but something like below can help ?
if asc(oldBullet) = 1 then replace by newBullet
...
I have a dictionary in MS Word format which I'd like to have cleaned from any paragraph breaks within dictionary entries, and keep only paragraph breaks that separate any two dictionary entries. This is how the layout of the dictionary looks now:
First picture http://img43.imageshack.us/img43/6476/snapshotpr.jpg
I'd need a macro or a regular expression that would first remove all the paragraph breaks, from the document, which would produce this layout:
Second picture http://img824.imageshack.us/img824/5219/snapshot1i.jpg
and then in the next step would add paragraph breaks only before the dictionary entries, which means only before bold phrases followed by the phonetic transcription in square brackets, to get this layout:
Third picture http://img849.imageshack.us/img849/2003/snapshot2qf.jpg
I used this site to help me with the paragraph markers.
Again, I recorded a macro with something did manually with 4 find/replace (two steps were used to make sure that a word followed by a square bracket was matched). Here's the macro:
Sub Separator()
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^13"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
.MatchFuzzy = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Font.Bold = True
With Selection.Find
.Text = "\["
.Replacement.Text = "^&"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Font.Bold = True
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "[a-z\-]# \["
.Replacement.Text = "^p^&"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Font.Bold = True
Selection.Find.Replacement.ClearFormatting
With Selection.Find.Replacement.Font
.Bold = False
.Italic = False
End With
With Selection.Find
.Text = "\["
.Replacement.Text = "["
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
Let me know if there's anything to tweak and I'll try to change it :)
EDIT: Part added for hyphens.