Search for text and add text after - vba

I have a document that contains the following text format that occurs throughout:
5:43-64
I want to search and replace so that the text reads like so:
5:43-64 indicates:
Fortunately, the - only appears in this type of text. The numbers change in each instance. So I don´t think I have to worry about some complicated search pattern. I can just search for the - character.
I want to then take whatever is after the the - and then save it as a variable then insert the text indicates afterward. I need this to loop through the whole document making these changes at any occurrence of the -.
Here is the code that I have up to this point that kind of half works:
Sub placeWordAfterDash()
Selection.Find.ClearFormatting
With Selection.Find
.Text = "-"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
If Selection.Find.Execute Then
Dim selectedString As String
Selection.Select
selectedString = Selection.Next(Unit:=wdWord, Count:=1).Text
Selection.Text = "-" & selectedString & " indicates: "
End If
End Sub
This code only makes the change in one instance and also leaves me with:
5:43-64 indicates: 64
Which isn´t quite what I want.

You don't need to use vba to do this find-replace, you can do it with a simple wildcard find-replace.
press CTRL+H, find (-<*>), Replace with \1 indicates: (make sure to check "Use Wildcards")
If you do want to use vba:
Selection.Find.ClearFormatting
With Selection.Find
.Text = "(-<*>)"
.Replacement.Text = "\1 indicates:"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll

Related

Find and Replace, replace is placing the character in the wrong location

Here is my text: “ Pulp Speed. ”
I use the [A-Z] because it could contain any letter at the start. My main objective is to replace space between the quote and first letter that starts the sentence. My code is a find and replace:
With ActiveDocument.Range.Find
.ClearFormatting
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = True
.MatchSoundsLike = False
.MatchAllWordForms = False
With .Replacement
.ClearFormatting
End With
.Execute FindText:=ChrW(8220) & " ([\#A-Z])", Replacewith:="""\1", _
Format:=True, Replace:=wdReplaceAll
End With
When it replaces my text i get P“ulp Speed.” I am trying to remove the blank space between the Quote and the P and not put it into the word itself. How can I resolve this?
I have rearranged it and found that sometimes it works and then sometimes it doesn't. Like it will place it one time in front and then the next time behind. I have no clue what is happening. But more than often it wont work.
Made the Updates mentioned below but still when running I am getting P"ulp Speed."
You set the parameters wrong for the find-object
You have to set MatchWildcards = true to enable a wildcard/regex search.
Furthermore .Wrap is not a boolean value but takes eg. wdFindContinue
So your code should look like this:
With ActiveDocument.Range.Find
.ClearFormatting
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = True
.MatchSoundsLike = False
.MatchAllWordForms = False
With .Replacement
.ClearFormatting
End With
.Execute FindText:=ChrW(8220) & " ([\#A-Z])", Replacewith:="""" & "\1", _
Format:=True, Replace:=wdReplaceAll
End With

Word Macro Search & Replace formating issue

I am trying to build a macro (as a noob) to find certain words and then change the formatting for that word (i.e. make it bold or italic)
This code 'sort of works.' It will find some words and change them but not change others. The weird thing is it works until I add another sub then it stops formatting on some words, while formatting others. The routine never breaks and runs until the end without error.
Can anyone teach why this is happening and what I am doing wrong? I am not a programmer. Thanks
Sub Macro2()
'
' Macro2 Macro
'
'
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Printer"
.Replacement.Text = ""
.Replacement.Font.bold = True
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "Parameter Values"
.Replacement.Text = ""
.Replacement.Font.bold = True
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
With Selection.Find
.Text = "Use All Applicants Indicator"
.Replacement.Text = ""
.Replacement.Font.bold = True
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
With Selection.Find
.Text = "Next Section"
.Replacement.Text = ""
.Replacement.Font.bold = True
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
I would program the search macro as a separate sub, like this.
Private Sub FindAndReplace(ByVal Txt As String, _
Optional ByVal NewTxt As String, _
Optional ByVal Fmt As Boolean = False, _
Optional ByVal BldFmt As Boolean = False)
With ActiveDocument.Content
With .Find
.ClearFormatting
.Text = Txt
.Format = Fmt Or BldFmt
With .Replacement
.ClearFormatting
.Text = NewTxt
.Font.Bold = BldFmt
End With
.Forward = True
.Wrap = wdFindContinue
.MatchCase = False
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
.Find.Execute Replace:=wdReplaceAll
End With
End Sub
All the optional parameters you may use but don't have to.
Then I would call the sub repeatedly with different parameters, perhaps like this:-
Sub MakeReplacements1()
FindAndReplace "Printer", BldFmt:=True
FindAndReplace "Parameter values", BldFmt:=True
FindAndReplace "Use All Applicants Indicator", BldFmt:=True
FindAndReplace "Next Section", BldFmt:=True
End Sub
or even like this:-
Sub MakeReplacements2()
Dim Fnd() As String
Dim i As Long
Fnd = Split("Printer|Parameter values|Use All Applicants Indicator|Next Section", "|")
For i = 0 To UBound(Fnd)
FindAndReplace Fnd(i), BldFmt:=True
Next i
End Sub
Selection is an object comprising the part of the document currently selected.
Find is a property of the Selection object defining the Find object (same name but one is a property, the other an object). The Find object has properties such as Text, Forward, Wrap, etc. and it has methods like ClearFormatting or Execute. All of this you can read up in the MSDN library.
Now, when you define the Find object you are describing something you want to find. With the Execute command you start looking for it. Your code is missing this command in some places.
The search is limited to the Selection. If you have selected nothing Word will presume you want to search the whole document. But Selection.Find will change the Selection to highlight the found item. Therefore, if you want to continue searching the whole document you would need to reset the Selection after each search with, for example, Activedocument.Content.Select.
In a nutshell, if you clear the Find object after each use, set a new description before each repeated use, define the Selection object for each search and don't forget to Execute each separate search your code should work just as you intend it to work.

VBA find-replace macro for MSWord 2013

I've done some googling and was not able to find a way to create a VBA macro code for my specific need. What I'm trying to accomplish is having the macro search through some XML code I paste into Word, find the value between <CID>*</CID> and <FirstName>*</FirstName>, extract the values, then replace it with the new element format: <FName id="*">*</FName>, where * represents a wild card search for any value between the two element tags. So in my XML code example below, I want the macro to extract "59" and "John", delete the whole code and past the extracted values to new element format: <FName id"59">John</FirstName>. My code and VMBA macro:
***XML Code***
<CustIDandName>
<CID>59</CID>
<FirstName>17</FirstName>
</CustIDandName>
Changing it to <FName id="59">John</FName>
***Word VBA Macro Code I have so far...***
With Selection.Find
.Text = "\<FirstName\>*\<\/FirstName\>"
.Replacement.Text = "<FName id="59">John</FName>"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = True
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
You can achieve this using a Word wildcard search and replace pattern:
Find text:
\<CID\>([0-9]*)\</CID\>*\<FirstName\>(*)\</FirstName\>
Replacement text:
<FName id="\1">\2</FirstName>
As the replacement text contains quotes, you must make sure that the automatic replacement of straight quotes with typographic quotes is disabled.
Dim AutoFormatAsYouTypeReplaceQuotes As Boolean
Dim AutoFormatReplaceQuotes As Boolean
' remember auto correct options
AutoFormatAsYouTypeReplaceQuotes = Options.AutoFormatAsYouTypeReplaceQuotes
AutoFormatReplaceQuotes = Options.AutoFormatReplaceQuotes
' disable auto correct of quotes
Options.AutoFormatAsYouTypeReplaceQuotes = False
Options.AutoFormatReplaceQuotes = False
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "\<CID\>([0-9]*)\</CID\>*\<FirstName\>(*)\</FirstName\>"
.Replacement.Text = "<FName id=""\1"">\2</FirstName>"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll

wdReplaceAll empty replacement text doesn't work

I have taken over a macro on a word document which has the following function:
Private Sub ConvertTildeToBullets()
With Selection.Find
.Text = "~ "
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Replacement.style = ActiveDocument.Styles("ieMR table bullet 1")
.Replacement.Text = " "
.Execute Replace:=wdReplaceAll
End With
End Sub
So it converts a sentence starting with a tilde (~) to bullet style. The program that outputs the original word document puts a space after the tilde and at the bottom of the function it replaces the tilde and space with a space. However my boses don't want that space and as soon as it is changed to .Replacement.Text = "" it doesn't replace any of the tildes.
How to I run wdReplaceAll with an empty replacement text?
Try with changing three lines of your code:
....
.Text = "(~ )(*)"
....
.MatchWildcards = True
....
.Replacement.Text = "\2"
....
It works for quick test & try I just made. Hope it will work for you as well.

Eliminate space in word file

in my word file there are hundrens of paragraph which like the format below. There is a single letter Y here. It can be other letter except "A","T","C","G". I want to remove the white space in it then create a new line.
AAATGGGCCC CACAGAAGTG AGAATGGGTG AAGTCAGAAT TCCTGGTAAT GAAGTGCTTG
AACTTGGATT CCTCCCGACA TGTGCAGTAC AATGAGATGA TTTTCTCCTT AATGAGATTA
GGAAATTCTA TTAGCGCTCC CAGCTGCTGA CCCGATTCCA TGAGGCTGAG GCTCCAGGGC
TGAACCTGCC TGGTT
Y
AGTGTTCCTG GAAACTAGAC ACCCCACCCT TCAGATGGGC CAGGGCCTCC CCAGCTCTAC
CTAAAGCTGT GGTCTGCCCC CAGGGGTGCC CAGTTTCCTC CCTTCACCCT GTGCTCCAGA
GGAGTGTGGG GCCCTGGGCA TTCTGCAGTG TACCCCAGGA TCCTCACTCC TTCCTGCTTA
The new line's format is
AAATGGGCCCCACAGAAGTGAGAATGGGTGAAGTCAGAATTCCTGGTAATGAAGTGCTTGAACTTGGATTCCTCCCGACATGTGCAGTACAATGAGATGATTTTCTCCTTAATGAGATTAGGAAATTCTATTAGCGCTCCCAGCTGCTGACCCGATTCCATGAGGCTGAGGCTCCAGGGCTGAACCTGCCTGGTT[Y]AGTGTTCCTGGAAACTAGACACCCCACCCTTCAGATGGGCCAGGGCCTCCCCAGCTCTACCTAAAGCTGTGGTCTGCCCCCAGGGGTGCCCAGTTTCCTCCCTTCACCCTGTGCTCCAGAGGAGTGTGGGGCCCTGGGCATTCTGCAGTGTACCCCAGGATCCTCACTCCTTCCTGCTTA
Notice Y becomes [Y].
The final result will be saved as a text file. Thanks for help.
You don't need to write a program. The “Replace” tool is sufficient for this:
Replace Y with [Y] (EDIT: see the comments below, because it's a little more complex than that indeed)
Replace ^w with nothing (^w means whitespace)
Replace ^p with nothing (^p means paragraph markers)
EDIT: if you need a macro, just do the above once while recording a macro.
EDIT: by applying the method discussed in the comments, I get the following VBA macro:
Sub ProcessATCG()
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "([!ACGT^13^32])"
.Replacement.Text = "[\1]"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "[^13^32]"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub