View Single Post
 
Old 05-18-2018, 11:38 AM
MaryTom MaryTom is offline Windows 10 Office 2016
Novice
 
Join Date: May 2018
Posts: 2
MaryTom is on a distinguished road
Default Macro to highlight wildcard phrase, copy and paste into new doc.

I handle documents with embedded tags enclosed in angled brackets, and I need to see the tags separately to ensure they are correct. I can use wildcard search to find all the tags, but I am trying to do a macro to find the tags, then copy/paste into a new document so all I have is a list of tags in the separate document. I assumed that using Find to highlight, then selecting all highlighted text and copy and pasting would be the easiest way, but I cannot get it to work. It hangs and crashes Word, though it seems to highlight. I put in the message box to see if it gets there, and it never does. I only need the one wildcard search term, but I could not figure out how to get it to search through the whole document one time and highlight, so I came up with what you see below. Can anyone help me correct this macro? I feel like it should be simple.

Sub temp()
'
' t' Macro to find the codes and highlight them. Then you can copy all highlighted text into a new doc and erase highlight.
Dim Word As range
Dim WordCollection(0) As String
Dim Words As Variant

'Define list. If you add or delete, change value above in Dim statement.
WordCollection(0) = "[<]*[>]"
'WordCollection(1) = ""
'Set highlight color.
Options.DefaultHighlightColorIndex = wdYellow

'Clear existing formatting and settings in Find feature.
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting

'Set highlight to replace setting.
Selection.Find.Replacement.Highlight = True

'Find words & Highlight
For Each Word In ActiveDocument.Words
For Each Words In WordCollection
With Selection.Find
.Text = Words
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = True
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Next
Next
MsgBox "Finished search. All codes should be highlighted. Will now create new document."

'Find all highlighted & copy it ???

'New doc
'Documents.Add Template:="Normal", NewTemplate:=False, DocumentType:=0
' Selection.Paste
End Sub
Reply With Quote