VBA Word Macro insertafter range string array occurrences multiple words

[macrointraining]

I have about 6 months of limited vba Word macro experience. I have been searching and experimenting for weeks to search a selection for intact words and multi-word phrases found from an array and list all found in an InsertAfter the selection, regardless of single words or multiple word phrases. The macro below does the InsertAfter the selection with the single words, but the multiple word phrases are omitted. I have another macro that highlights both the single words and mulitiple word phrases, but am unable to figure out how to InsertAfter the selection words and phrases found in that one as well. I would like a macro to list both the single words and multiple word phrases found from an Array (without having to go to an outside .doc) and insert a comma separated InsertAfter the selection. See below for an example and macro. Is it possible to tweak the macro below to search, find, and InsertAfter a selection both single words and multiple word phrases? Any help is appreciated. Thanks.

-macrointraining

For example, for the selection:
*Designing this project through the ups and downs*
searching for the following with a selection of the above using:
myWords = Array("through", "this project", "ups and downs")
yields an InsertAfter the selection of:

(myWords found: through)

The "this project" and "ups and downs" are omitted. I would like all words and phrases as found in InsertAfter, for example (myWords found: through, this project, ups and downs). Phrases are to be intact.

Sub WordsPhrasesFoundInsertAfterSelection()

Dim myWords() 'Array of words and phrases
Dim strResults As String 'myWords found
Dim r As Range 'Create a Range object
Dim var As Variant
Dim numfound() As Integer 'Runs in myWords found counts
Dim idx As Integer 'Runs in myWords found counts
Dim MyRange As Object 'Runs for the whole program
Set MyRange = Selection.Range 'myWords found listed after the Selection
Dim j As Long

myWords = Array("through", "this project", "ups and downs")
ReDim numfound(0 To UBound(myWords))

For Each r In Selection.Words
MatchAllWordForms = True
idx = 0
For Each var In myWords
If Trim(r.text) = myWords(idx) Then
numfound(idx) = numfound(idx) + 1
End If
idx = idx + 1
Next var
Next r
idx = 0
For Each var In myWords
If numfound(idx) > 0 Then
strResults = strResults & myWords(idx) & ", "
End If
idx = idx + 1
Next var

MyRange.Collapse Direction:=wdCollapseEnd
If strResults = "" Then GoTo ErrorHandler
MyRange.InsertAfter text:= _
"(myWords found: "
strResults = Left(strResults, Len(strResults) - 2)
MyRange.InsertAfter strResults
MyRange.InsertAfter text:= _
")"
ErrorHandler:

With MyRange
.Font.Name = "Arial"
.Font.Size = 11
.Font.Bold = False


.Font.Underline = False
.ParagraphFormat.Alignment = ppAlignLeft
.ParagraphFormat.LeftIndent = 0
.Font.ColorIndex = 1 'black
.ParagraphFormat.SpaceBefore = 0
.ParagraphFormat.SpaceBeforeAuto = False
.ParagraphFormat.SpaceAfter = 0
.ParagraphFormat.SpaceAfterAuto = False
.ParagraphFormat.LineSpacingRule = wdLineSpaceSingle
.ParagraphFormat.LineUnitBefore = 0
.ParagraphFormat.LineUnitAfter = 0
Options.DefaultHighlightColorIndex = wdNoHighlight
End With
MyRange.InsertAfter (Chr(11))
MyRange.InsertBreak Type:=wdSectionBreakContinuous
End Sub

[June7]

Why don't you post this in a Word forum?

Or at least provide the Word document with the code. I've never coded in Word so I just did copy/paste your code into VBA behind Word document and it errors on the Sub declaration line. Doesn't like the & character. Did this code actually run for you? How do you run this code aside from using the Run button on VBA editor?

Have you step debugged? You will see that each r in Selection.Words is a single word so of course only the single word values in the array will match.

What is the code that does the highlighting?

This code worked for me to match each array value:

Sub WordMatch()
Dim strFound As String, MyWords As Variant, i As Integer
MyWords = Array("through", "this project", "ups and downs")
For i = 0 To UBound(MyWords)
    If Selection.Text Like "*" & MyWords(i) & "*" Then strFound = strFound & MyWords(i) & ", "
Next
Debug.Print strFound
End Sub

[macrointraining]

Thank you for the reply. This is my first post to a macro forum. Any suggestions for a Word macro forum?

Edit the Title as Sub WordsPhrasesFoundInsertAfterSelection()

See the post below for the debug reply.

[macrointraining]

Yes, the code runs. See above for details.

[June7]

I did some edits on previous post.

I don't know any Word forums.

[macrointraining]

Thank you for the edits. In the original macro in the first post, the program runs with no macro-stopping errors with no debug highlights. The multiword phrases are listed in the Array but not found and inserted in the InsertAfter when present in the material searched. They are disregarded. The Selection.Words has had me stumped for weeks in trying to find a replacement code that works for all words and phrases and not just single words. My understanding is that may be an Array condition, but I may be wrong.

Both macros are run on a word document which contains, for example, only the following statement without the asterisks:
*Designing this project through the ups and downs*
where all three instances from the Array should be found and listed in the InsertAfter selection.

Below is the macro for highlight single and multiword phrases. The macro works for highlighting but once again have yet to figure out how to InsertAfter the selection for the found words and phrases. Possibly there is another term for selection and InsertAfter phrases for a string versus array. If either macro could be tweaked for words and phrases found and listed with the InsertAfter the selection that would be great. Either way, the InsertAfter selection with the found words and phrases is most important.

Thanks.

Sub HighlightSingleWordsMultiwordPhrases()

Application.ScreenUpdating = False
Dim StrFnd As String, rng As Range, i As Long
Dim lngHCI As Long
lngHCI = Options.DefaultHighlightColorIndex
Options.DefaultHighlightColorIndex = wdBrightGreen
'Examples of single, double, and triple word phrases are below
'End result, all words and phrases found from StrFnd are highlighted
StrFnd = "through,this project,ups and downs"
For i = 0 To UBound(Split(StrFnd, ","))
Set rng = ActiveDocument.Range
With rng.Find
.ClearFormatting
.text = Split(StrFnd, ",")(i)
.Replacement.ClearFormatting
.Replacement.Highlight = True
.Replacement.text = "^&"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=wdReplaceAll
End With
Next
End Sub

[macrointraining]

Thanks, the edit worked! I also ran the macro where only two of the phrases were selected, and the macro worked and listed just the two phrases found even though three were listed in the array.
The final macro version for finding and InsertAfter Selection words and phrases found:

Sub WordMatch()

Dim strResults As String, MyWords As Variant, i As Integer
Dim MyRange As Object 'Runs for the whole program
Set MyRange = Selection.Range 'myWords found listed after the Selection
'A one-word, two-word, and three-word example search is below
MyWords = Array("through", "this project", "ups and downs")
For i = 0 To UBound(MyWords)
If Selection.text Like "*" & MyWords(i) & "*" Then strResults = strResults & MyWords(i) & ", "
Next

MyRange.Collapse Direction:=wdCollapseEnd
If strResults = "" Then GoTo ErrorHandler
MyRange.InsertAfter text:= _
"(myWords found: "
strResults = Left(strResults, Len(strResults) - 2)
MyRange.InsertAfter strResults
MyRange.InsertAfter text:= _
")"
ErrorHandler:

With MyRange
.Font.Name = "Arial"
.Font.Size = 11
.Font.Bold = False
.Font.Underline = False
.ParagraphFormat.Alignment = ppAlignLeft
.ParagraphFormat.LeftIndent = 0
.Font.ColorIndex = 1 'black
.ParagraphFormat.SpaceBefore = 0
.ParagraphFormat.SpaceBeforeAuto = False
.ParagraphFormat.SpaceAfter = 0
.ParagraphFormat.SpaceAfterAuto = False
.ParagraphFormat.LineSpacingRule = wdLineSpaceSingle
.ParagraphFormat.LineUnitBefore = 0
.ParagraphFormat.LineUnitAfter = 0
Options.DefaultHighlightColorIndex = wdNoHighlight
End With
MyRange.InsertAfter (Chr(11))
MyRange.InsertBreak Type:=wdSectionBreakContinuous
End Sub

Solved! Result for:

MyWords = Array("through", "this project", "ups and downs")

searched for in:
*Designing this project through the ups and downs*
(myWords found: through, this project, ups and downs)

and:
Designing this project through the ups and downs 'Select only *through the ups and downs*
(myWords found: through, ups and downs)

Brilliant! I assume either the asterisks in "*" & MyWords(i) & "*" or the Selection.text (or both) allowed for multiple words. Thanks again.

-macrointraining

[June7]

The asterisk is wildcard character.

[macrointraining]

The macro generally works. However, I ran across a couple of scenarios the macro did not recognize. The first is the macro does not recognize a match if there are capital letters in the phrase. The second scenario is undesired matching of the root word with a either a prefix or suffix present (e.g., the word "thorough" is listed as a match for the word "thoroughly"). Exact word matches are desired while allowing capital letters.

'For example, for the array words of "thorough", "this project", and "ups and downs"
myWords = Array("thorough", "this project", "ups and downs")

'The macro search of the selected phrase *This project is thoroughly full of ups and downs*

'Result in the InsertAfter:
(myWords found: thorough, ups and downs)
'the "This project" is disregarded, and "thoroughly" is considered a match.

'Result desired in the InsertAfter:
(myWords found: this project, ups and downs)

Any suggestions or help would be greatly appreciated.

[June7]

Access is not case sensitive unless you tell it to be.
http://support.microsoft.com/kb/209674
http://support.microsoft.com/kb/98227

Apparently Word/VBA is the same.

Sorry, text pattern search and matching is not an exact science.

The only suggestion I can offer is that you concatenate a space at each end of the array value but that will probably cause other issues.