Count replacements made by "Replace All" in VBA - vba

I'm working on a macro that parses a document and modifies style when needed. So far, one of my sub uses Find & Execute with a loop to go through all paragraph with a defined Style. It worked well enough and made it easy to know how many times an modification is made.
However, it appears that .Execute Replace:=wdReplaceAll is far more efficient, but doesn't return this latter information in VBA, even though it is displayed when used directly in Word (with Ctrl + H).
How can I bypass this issue to count the number of replacements?
Thanks a lot in advance.

You could do this with a combination of Word's built in find and replace and a search and replace using the regex library (Microsoft VBScript Regular Expressions 5.5).
The VBScript regular expressions cannot search for styles, only text but can provide the number of matches found.
Thus you first do a search and replace for the paragraph marker of the style in which you are interested (^p + style). You replace the paragraph marker with an amended paragraph marker such as '###^p' being careful to replace with the same style.
You then use the regex search and replace to find the paragraph marker modifier and replace it with nothing, thus restoring the original text. The regex has a method .Matches.Count which will give you the number of replacements of ### that were made.
You may find the following stack overflow link of help
How to Use/Enable (RegExp object) Regular Expression using VBA (MACRO) in word

Try something based on:
Sub Demo()
Application.ScreenUpdating = False
Dim i As Long
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = InputBox("What is the Text to Find")
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
End With
Do While .Find.Found
i = i + 1
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
Application.ScreenUpdating = True
MsgBox i & " instances found."
End Sub
The above code doesn't actually replace anything - it simply counts the instances of what's found.

Related

Deleting Empty Paragraphs in Word - but not objects/pictures

I'm using the macro from #Wayne G. Dunn on this question and it works great, but it doesn't understand when there are pictures/objects in my document and deletes them.
Would there be any way around it?
The said document is a Word file exported from an online app/software we use at work, if it helps. I don't know the specs of the picture.
The code in your linked thread is awful and is indeed liable to delete shapes attached to paragraphs. There is also no need to loop through every paragraph. Indeed, a macro isn't even needed for most cases. All you need is a wildcard Find/Replace, where:
Find = [^13]{2,}
Replace = ^p
As a macro, this becomes:
Sub Demo()
Application.ScreenUpdating = False
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "[^13]{2,}"
.Replacement.Text = "^p"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchWildcards = True
.Execute Replace:=wdReplaceAll
End With
End With
Application.ScreenUpdating = True
End Sub
Note: For systems using non-english regional settings, you may need to use:
[^13]{2;}
instead of:
[^13]{2,}
in both the Find/Replace and the macro.

Find the exact digits in a Word Document

I am trying to find specific digits in a Microsoft Word Document which contains text and digits, with VBA.
For example the text in the document is as follows;
(1) 52.203-19, This is a some text here
(2) 52.204-23, Quick brown fox jumped over the lazy dog 52 times.
(3) 52.204-25, I tried to search for a solution 52.204 times.
(4) 52.2, Could not find any luck though
(5) 52.203, this is blowing my mind away with mac 2.36
I wish to find the exact digits "52.2" as a whole.
I don't want to find instances where 52.2 is a part of another number like 52.203 or 52.204.
Also when I would like to find 52.203 then I want to exclude all instances like 52.203-xx where xx could be any two digit number.
In short I would like to find the exact number only as a whole and not in between the numbers, just like Excel's EXACT function.
Should I use RegEx or should I use Word's Advanced Find function with wildcards through VBA?
What I have finds all instances which I don't want.
Selection.Find.ClearFormatting
With Selection.Find
.Text = "52.2"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Regular expressions seems like the way to go for this.
First, go to Tools > References in the VBA editor and make sure that there is a check next to the Microsoft VBScript Regular Expressions 5.5 library.
The following code worked for me on your sample text to remove only the '52.2' after the '(4)' without affecting any of the surrounding characters:
Sub removeNumber()
Dim regExp As Object
Set regExp = CreateObject("vbscript.regexp")
With regExp
.Pattern = "\b52.2\b"
.Global = True
Selection.Text = .Replace(Selection.Text, "")
End With
End Sub
\b means word boundary so will not match any digits before or after the '52.5'.
No need for RegEx. You can use Find with wildcards. For explanation see https://wordmvp.com/FAQs/General/UsingWildcards.htm
The solution proposed by Mr. #TimothyRylatt worked for me perfectly specially after the addition of [!-] to avoid the hyphen containing numbers. However, I needed to implement this solution through a VBA Macro so I modified my code a little bit like this.
The working of Modified Code & the Code itself
Sub find_numbers()
Dim Str As String
'Create Search String for WildCard Search
Str = "<" & "52.203" & ">" & "[!-]"
Selection.Find.ClearFormatting
With Selection.Find
.Text = Str
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = True 'make this option true to use WildCards
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
End Sub

Howto set Range to third Heading1 style match?

I have a document where I want to start start searching in section 3 to the end of the document and bold text based on my user-defined style since other styles used may contain the same word I don't want to bold - including the possibility of the Heading/section.
I do have VBA code that works by finding my user-defined style throughout the document and bolding it for one style match only. However, the .Style in the .find doesn't allow one to specify a wildcard style i.e. my user-defined style set of "Requirement1 thru Requirement9" which are based off the Heading1-9 style. I assume I'll have to create a for loop outside of the "with" that finds my user-defined style that is passed one at a time to bold the text to match one style at a time i.e Requirement1 thru Requirement9. Is there a better way? see code below.
The next issue is to focus the search of this text to bold to start in a particular section to the end of the document. For me, its section 3 to the end of the document or till it encounters another style defined as Appendix1 and stop. I do have user-defined styles Appendix1 thru Appendix9 that are also based off of Heading1-9. The reason to search on a style as a starting point is because these other sections before section3, or descriptive text in Section 3 and beyond may contain the word I'm trying to bold - which I don't want to do except when my particular user-defined style Requirment1-9 was applied that is used in section 3 and beyond. In trying to implement this part before doing the word searching and bolding part, I've been searching based on the "Heading1" style and when I found the third one, I know I'm in section 3. I can't use the VBA "sections" search since it includes all the subsections of a document which can vary from document to document and specifying sections.item(3) doesn't mean I'll get the third section of my document that corresponds to the third Heading1 style.
Since I'm not that adept at the various VBA sections,paragraphs,sentences, characters and everything else when applying the "range" either before, after, or both on any of these (never seems to work the way one expects. Even the VBA hint tools says one can do it, but runtime says error) I've started with the specifying the start/end of the whole activedocument.range. Then I perform a ".find" of the "Heading1" style in a for loop three times which does find them. I then try to assign the last Heading1 found range value as the start value to use in the next embedded "find" that will search and apply the bold to the "Requirement1" style. (May need to create a loop to search Requirement1-9 styles as stated above). To help me know where I'm at, I'm trying to dump via debug.print the range position, but it dumps the all whole document text to the debug window and not the integer value I thought I'd get. Whats the issue with doing this? I've even tried to use a selection.range and dump the retrieved text to the debug.print window without success. It makes it worse since the processing timing seems to run forever. The wdFindStop doesn't force the find to stop on the third find either.
So how to:
a). find and dump the range position to the debug window along with the text at this position. Both the number and text will tell me where I'm at.
c). How to assign the range position based on find of the third "Heading1" position in the document so that that the second "with" can search and apply the bolding to the text I want to bold.
d). How to do a wildcard search on the .Style user-defined Requirement1-9 style instead of having to create a for loop to search one at a time?
The following is the VBA code I have written.
Attribute VB_Name = "BoldMustShall2_M"
Option Explicit
Public Sub BoldMustShall2()
' If .Parent.Bold = True is used with wdReplaceall, the whole
' document is bolded even when the sentence doesn't have any of the words
' being searched for.
Dim myRange, rngSel As Range
Dim oDoc As Word.Document
Dim pos1, pos2 As Long
Dim numchars As Long
Set oDoc = ActiveDocument
Set rngSel = Selection.Range
Application.ScreenUpdating = False
'Set the starting Heading to search as Section 3
pos1 = oDoc.Range.Start
pos2 = oDoc.Range.End
Set myRange = oDoc.Range(Start:=pos1, End:=pos2)
'Another way is to find the "Heading1" style and set the range start to the third one found which is section 3.
'Counting Word sections can vary alot so its not the best way.
'The same would apply if Appendix1 style is used and assuming that requiremens start in the third one.
Debug.Print "My Start Range " + myRange
With myRange
.TextRetrievalMode.IncludeFieldCodes = False ' don't want to search fieldcodes for must/shall
.TextRetrievalMode.IncludeHiddenText = False ' don't want to search hiddentext for must/shall
' Get the range position for Heading1 style for section 3 of PRD.
Dim i As Integer
Dim ReqHDR As Range
Dim bFind As Boolean
With .Find
.ClearFormatting
.Forward = True
'.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = True
.MatchWildcards = False
.Style = "Heading1"
'Loop three times for Style
For i = 1 To 3 Step 1
'bFind = .Execute
.Execute Wrap:=wdFindStop
If .Found = True Then
rngSel = oDoc.Range 'This should be the current position in the Document for the requirements.
' When found it outputs the message once
Debug.Print "Found a Heading1 style "
.Replacement.Font.Size = 20
End If
'.Wrap = wdFindStop
Next i
End With
Debug.Print "End of Heading1 Search "
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = True
.MatchWildcards = False
.Replacement.Font.Bold = True
.Replacement.Font.Name = "Times New Roman"
.Replacement.Font.Size = 12
.Replacement.Font.Italic = True
'.Style = "Requirement1" ' A loop is needed to cycle thru all the Requirement1-9 styles. No wildcard.
'.Style = wdStyleNormal
.Replacement.Text = "^&" ' This is the contents of the find what box in word.
' In this case the .find.text "must" statement.
' Alternate is to specify "must" or "shall" but this
' would require two replace.text statements instead of
' just this one. The ^& is a special command that eliminates
' the need to set the replacement.Text info.
'.Text = "must"
.Execute FindText:="must", Replace:=wdReplaceAll
If .Found = True Then
' When found it outputs the message once
Debug.Print "Found one or more must "
End If
'.Text = "shall"
.Execute FindText:="shall", Replace:=wdReplaceAll
If .Found = True Then
' When found it outputs the message once
Debug.Print "Found one or more shall "
End If
End With
End With
Application.ScreenUpdating = True
Debug.Print "Completed searching for must/shall in document."
End Sub
Assuming that, when you refer to 'Sections', you're referring to parts of your document delineated by Section breaks, perhaps something along the lines of:
Sub Demo()
Application.ScreenUpdating = False
Dim Rng As Range, i As Long
With ActiveDocument
Set Rng = .Range(.Sections(3).Range.Start, .Range.End)
With .Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ""
.Replacement.Text = ""
.Forward = True
.Format = True
.Wrap = wdFindContinue
.Style = "Appendix1"
.Execute
End With
Rng.End = .Start
End With
With Rng.Find
.ClearFormatting
.Replacement.ClearFormatting
.Forward = True
.Format = True
.Replacement.Style = "Strong"
.Wrap = wdFindStop
.Replacement.Text = "^&"
.Text = "must"
For i = 1 To 9
.Style = "Requirement" & i
.Execute Replace:=wdReplaceAll
Next
.Text = "shall"
For i = 1 To 9
.Style = "Requirement" & i
.Execute Replace:=wdReplaceAll
Next
End With
End With
Application.ScreenUpdating = True
End Sub
Note that, instead of using hard formatting for the replacement, I've simply applied Word's built-in 'Strong' Style. Your own code should use a Style, too, whether it's Word's 'Strong' Style or another character Style of your own definition.

Conditional Replace in Word Macro

Hi all and thanks in advance for any replies;
This question is about replacing text only under certain conditions.
Background: I'm working on a macro for the editorial department of an academic institution. They get loads of documents that have the same issues and asked for some help to reduce the time they spend on each one.
Two of the things they want:
If a hyphen is between two digits, change it to an en-dash
Change every ampersand (&) to the word "and"
I have a RegExp that finds and replaces those hyphens just fine, but I noticed a problem. My find/replace changes the "display text" of hyperlinks. Same with ampersands. Bad. So what I'm trying to figure out is how to exclude text that has Selection.Style = Word.ActiveDocument.Styles("Hyperlink")
BTW, what's the logical operator for "not equal"? I tried <> and >< but I always get an error telling me that an expression is expected. I'm new to VBA so please forgive the newbie question.
This is working (part of a much larger Sub):
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "([0-9])-([0-9])"
.Replacement.Text = "\1" & Chr$(150) & "\2"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = True
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
So can I create an If/Then statement to tell it to replace only if the style is not hyperlink?
Thanks again,
Rissa
P.S. I searched for similar posts and found one but it had never been answered.
Maybe a safer way to find out if your selection is a hyperlink is to use the following VBA code:
If Selection.Hyperlinks.Count = 1 Then
MsgBox "The selection is a hyperlink"
Else
MsgBox "The selection is not a hyperlink"
End If
I just tested it quickly and it works perfectly. To answer you second question, operations such as "=" and "<>" are for basic types such as Integer, Float, Long etc. Word.ActiveDocument.Styles("Hyperlink") returns an object. Therefore you would need to use "Is" and "Is Not"
Hope that helps.
(Thanks Black Cr0w, the logical operator is good to know)
OK, here's the deal...Word Macros don't exactly execute linearly.
I eventually figured out how to write an If/Then/Else statement that mostly worked. Mostly. It didn't actually check the condition until after it did a replace (wdReplaceOne). So it would change the first hyphen in a hyperlink and then go "oh, wait! This is a hyperlink!" and then it would skip any subsequent hyphens in that hyperlink.
So I ended up splitting my If/Then/Else into two separate If/Then blocks. The first one says "move along, nothing to do here," and the second one says, "aha! here's where we need a change." The code below, although cringe-worthy, does exactly what I want.
Sub replaceHyphens()
'
' Find hyphens that occur between digits and change them to en-dash, EXCEPT in hyperlinks
'
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "([0-9])-([0-9])"
.Forward = True
.Format = True
.Wrap = wdFindContinue
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = True
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
End With
Do While (Selection.Find.Found = True)
If (Selection.Style = ActiveDocument.Styles("Hyperlink")) Then
Selection.Move Unit:=wdSentence, Count:=1
End If
Selection.Find.Execute
If (Selection.Style <> ActiveDocument.Styles("Hyperlink")) Then
Selection.Find.Replacement.Text = "\1" & Chr$(150) & "\2"
Selection.Find.Execute Replace:=wdReplaceOne
End If
Loop
End Sub
If anyone wants to suggest a cleaner way to do this, I'm all ears.
Thanks!

In VBA, how to insert text before and after style?

I have been trying to work out how to insert text before and after a given style in Word using VBA.
At present I run through the document from top to bottom, find the style, and make the insertions. It is time-consuing and inelegant (to say the least).
It should be possible to use a Range object and
Selection.InsertBefore ()
and
Selection.InsertAfter ()
but I can't get it to work.
Does anyone know how to do this?
This a second edit to give a better idea of the sort of thing I am looking for, but would need it modified to find a particular style:
Sub InsertBeforeMethod()
Dim MyText As String
Dim MyRange As Object
Set MyRange = ActiveDocument.Range
MyText = "<Replace this with your text>"
' Selection Example:
Selection.InsertBefore (MyText)
' Range Example: Inserts text at the beginning
' of the active document.
MyRange.InsertBefore (MyText)
End Sub
Another way it might be possible to fo this, is through using wildcards and style, but when I use (*) it only finds one character with the style, not the whole string.
Maybe there is some way to make it find the whole string? Then it would be possible to do a "replace all" with "mytext1"\1"mytext2"
Word has a feature to find and replace text with certain styles, so you don't even need a macro. But if you wish to automate it with VBA, the following sample code inserts foo in front of any Heading 2-styled code and appends bar afterwards:
Selection.Find.ClearFormatting
Selection.Find.Style = ActiveDocument.Styles("Heading 2")
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ""
.Replacement.Text = "foo^&bar"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll