![]() |
#1
|
|||
|
|||
![]()
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 |
#2
|
||||
|
||||
![]()
Try:
Code:
Sub Demo() Application.ScreenUpdating = False Dim DocSrc As Document, DocTgt As Document Set DocSrc = ActiveDocument Set DocTgt = Documents.Add With DocSrc.Range With .Find .ClearFormatting .Replacement.ClearFormatting .Text = "\<*\>" .Replacement.Text = "" .Format = False .Forward = True .Wrap = wdFindStop .MatchWildcards = True .Execute End With Do While .Find.Found DocTgt.Range.InsertAfter .Text & vbCr .Collapse wdCollapseEnd .Find.Execute Loop End With Application.ScreenUpdating = True End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#3
|
|||
|
|||
![]()
Ah, thank you so much! That seems to be exactly what I need. I appreciate the tip about the hashtags on the menu for codes too.
You're awesome! |
![]() |
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
copy a row and paste the row into another sheet more then one time:macro | waqar1239 | Excel Programming | 1 | 04-07-2017 09:57 AM |
![]() |
rsrasc | Excel Programming | 1 | 09-24-2016 01:25 AM |
![]() |
PRA007 | Word VBA | 2 | 10-17-2015 01:07 AM |
![]() |
rsrasc | Word VBA | 3 | 11-11-2014 03:55 PM |
![]() |
jperez84 | Word VBA | 10 | 09-19-2012 04:48 PM |