Selection.Find wildcard results to array - vba

Question

Consider the following macro, that I got from Macro Recorder:
Sub Macro8()
'
' Macro8 Macro
'
'
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find.Replacement.Font
.Bold = True
.Color = wdColorGreen
End With
With Selection.Find
.Text = "[0-9]{2}/[0-9]{2}/[0-9]{4}"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
How could I get all results and save them to an array?

Answer 1

You do this using Range objects. Think of a Range as being an invisible selection with the important difference that there can be many ranges, but only one selection.
In the code below the search Range (rSearch) is set to the entire document and the Find properties are defined for it, rather than Selection. I changed wrap from wdFindContinue to wdFindStop so that the macro won't start over from the beginning of the document again, and again, and again... And wdReplaceAll needs to be wdReplaceOne so that each found range can be processed.
The Do-loop is where the assignment of the found range to the array (aFoundRanges) takes place. If the search is successful the array is "redimmed" to accept an additional member. The found Range is "duplicated" to the range rFound, which is assigned to the array. The counter is incremented; rFound is re-set*. The search range is re-set to begin at the end of the last "hit" and end at the end of the document.
This loops until Find.Execute is no longer successful.
Sub KeepFoundInArray()
'
Dim rSearch As Word.Range
Dim rFound As Word.Range
Dim aFoundRanges() As Word.Range
Dim counter As Long
Dim bFound As Boolean
Set rSearch = ActiveDocument.content
rSearch.Find.ClearFormatting
rSearch.Find.Replacement.ClearFormatting
With rSearch.Find.Replacement.Font
.Bold = True
.color = wdColorGreen
End With
With rSearch.Find
.Text = "[0-9]{2}/[0-9]{2}/[0-9]{4}"
.Replacement.Text = ""
.Forward = True
.wrap = wdFindStop
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Do
bFound = rSearch.Find.Execute(Replace:=wdReplaceOne)
If bFound Then
ReDim Preserve aFoundRanges(counter)
Set rFound = rSearch.Duplicate
Set aFoundRanges(counter) = rFound
Set rFound = Nothing
counter = counter + 1
rSearch.Collapse wdCollapseEnd
rSearch.End = ActiveDocument.content.End
End If
Loop While bFound
Debug.Print UBound(aFoundRanges)
End Sub
It's necessary to duplicate the found range - if you don't, that range will be written to the array. And it will always reflect the current range rSearch - what the array members "point to" will be that Range. A duplicate copies the Range object and makes the copy independent of the original. That's also why it's a good idea to re-set rFound(Set rFound = Nothing) - to ensure the next instance of rSearch.Duplicate is again independent.