Word Macro Search & Replace formating issue - vba

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.

Related

Word not running certain macros

This bit of code has worked for years and now as of today it won't do anything. All I'm trying to do is highlight every instance of a superscript in the document.
Sub mcrHighLightSuperSript()
'
' mcrHighLightSuperSript Macro
'
Selection.Find.ClearFormatting
With Selection.Find.Font
.Superscript = True
.Subscript = False
End With
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Highlight = True
With Selection.Find
.Text = ""
.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
End Sub
Did Word do some update that makes this code invalid?
Thanks!
Instead of using the long chain of property and method calls, for example:
Selection.Find.Replacement.ClearFormatting
The Selection.Find method returns a Find object that contains the criteria for a find operation. So, you could retrieve the object instance once in the code and then re-use every time you need to set up a property or call a method.

How do I limit the find and replace procedure to execute only on certain pages?

I am using Microsoft Visual Basic on Word. I want to limit the find and replace function to operate only on certain pages of the document. How do I do it?
As of now, it will execute it the whole document which is not preferred.
Sub X_entity()
'
' Replaces lower and greater than symbols to html entity
'
'
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ">"
.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 = "<"
.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
Instead of using Selection (which is poor practice anyway), you should point to the range of each page in turn, using Find/Replace on the designated range only. For example:
Sub ProcessPages()
Application.ScreenUpdating = False
Dim i As Long, ArrPgs()
' Define the pages to process
ArrPgs = Array("7", "4", "3", "2")
For i = 0 To UBound(ArrPgs)
' Process the defined pages
With ActiveDocument.Range.GoTo(What:=wdGoToPage, Name:=ArrPgs(i)).GoTo(What:=wdGoToBookmark, Name:="\page").Find
.ClearFormatting
.Replacement.ClearFormatting
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWildcards = False
.Text = ">"
.Replacement.Text = ">"
.Execute Replace:=wdReplaceAll
.Text = "<"
.Replacement.Text = "<"
.Execute Replace:=wdReplaceAll
End With
Next i
Application.ScreenUpdating = True
End Sub
With the above code, the pages are processed in reverse order in case the Find/Replace messes with the pagination.

How to change text format using wildcards in VBA

Our Word documents have several occurrences of the text "Division XX" where XX ranges from 00 thru 99. I need to boldface these using VBA. Below is some code I adopted which gets me part way
With mDoc.Tables(1).Cell(1, 1).Range.Find
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Replacement.Font.Bold = True
.Execute FindText:="Division", Format:=True, ReplaceWith:="Division", Replace:=wdReplaceAll
End With
However, it doesn't select or highlight the " XX". I tried and failed to use wildcards because it wasn't clear to me what to use for the ReplaceWith value?
This worked for me:
Sub Tester()
With ThisDocument.Range.Find
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = True '<<**
.MatchSoundsLike = False
.MatchAllWordForms = False
.Replacement.Font.Bold = True
'Find instances of "Division" followed by space then at least one digit
.Execute FindText:="Division [0-9]{1,}", Format:=True, Replace:=wdReplaceAll
End With
End Sub
See: http://word.mvps.org/faqs/general/usingwildcards.htm
Give this a shot
Option Compare Text
Dim Search as Variant
For Each Search In ActiveSheet.UsedRange
If Search.Value Like "Division*" Then
Search.Font.Bold = True
End If
Next Search
Hope this helps

Search for text and add text after

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

Word 2010 VBA Replace within a highlighted range

The following code works, but it performs everything on the entire document. I'd like to highlight a block of text, then when I run the macro only have it work on the highlighted text. How do I do that? Thanks...
Sub DoCodeNumberStyle(numchars As String)
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "(^13)([0-9]{" + numchars + "}) "
.Replacement.Text = "\1###\2$$$ "
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Style = ActiveDocument.Styles("CodeNumber")
With Selection.Find
.Text = "###([0-9]{" + numchars + "})$$$"
.Replacement.Text = "\1"
.Forward = True
.Wrap = wdFindAsk
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
Sub CodeNumberStyle()
DoCodeNumberStyle ("1")
DoCodeNumberStyle ("2")
End Sub
PostScript:
One additional thing I've discovered: if you do more than one find on a Selection, the first find loses/changes the Selection, so the others are no longer bounded by the original Selection (and a wdReplaceAll will continue to the end of the document). To fix this, capture the Selection into a Range. Here's the final version of my method, which now does everything I need, is restricted to the original highlighted selection (even with 3 find-and-replacements), and has also been minimized, code-wise:
Sub AAACodeNumberStyleHighlightedSelection()
With Selection.Range.Find
.ClearFormatting
.Style = ActiveDocument.Styles("Code")
.Replacement.ClearFormatting
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
' First line:
.Text = "1 //"
.Replacement.Text = "###1$$$ //"
.MatchWildcards = False
.Execute Replace:=wdReplaceAll
' Rest of lines:
.Text = "(^13)([0-9]{1,2}) "
.Replacement.Text = "\1###\2$$$ "
.MatchWildcards = True
.Execute Replace:=wdReplaceAll
' Now style the line numbers:
.Text = "###([0-9]{1,2})$$$"
.Replacement.Text = "\1"
.Replacement.Style = ActiveDocument.Styles("CodeNumber")
.MatchWildcards = True
.Execute Replace:=wdReplaceAll
End With
End Sub
Change .Wrap to wdFindStop and this should work for you. I think this might be a minor Word bug; the documentation says that the Wrap value
sets what happens if the search begins at a point other than the beginning of the document and the end of the document is reached (or vice versa if Forward is set to False) or if the search text isn't found in the specified selection or range.
But it seems like it forces the Find to go to the end of the document rather than taking the selection into account. Anyway, there's no need for wdFindAsk if you only plan to run this on selections.
I, too, found that even when beginning a FIND loop on a range, the range is redefined by FIND, and so continuous loop on .execute goes beyond the original range to the end of the document. wdFindStop stops only at the end of the document, not at the end of the original range.
So, I inserted an IF statement:
do while .find.found
...
If .find.parent.InRange(doc.Bookmarks("BODY").Range) = False Then Exit Do
...
.execute
loop
Set myRange = Selection.Range
myRange.Select
With Selection.Find
.Text = "Apple"
.Replacement.Text = "Banana"
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
'.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
myRange.Select
With Selection.Find
.Text = "red"
.Replacement.Text = "yellow"
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
'.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll