![]() |
#1
|
|||
|
|||
![]()
Hello
I have the macro below, which opens 3 Windows. 1st window contains all the data that needs to be extracted. 2nd window is for when it cuts out a block of data from 1st window and places in 2nd window for further processing. 3rd window is used to process multiple instances of data that was found in 2nd window and keep taking that out until no more data is found and then from the 2nd window it goes back to 1st window and picks up the next block of data. Macro works fine its does all as above, but when the macro key is press its only takes out 1 record and then breaks and then I have to keep pressing the key over and over again to make it work. Is there is a way to put a loop on the top of the macro and end it by the end sub for the macro to run continuously until all Is processed. Attached is the dummy data file and logic file. Any help will be greatly appreciated. Thanks. ======================== Sub Macro1() ' ' Macro1 Macro ' Macro recorded 8/31/2023 by don ' Selection.MoveDown Unit:=wdLine, Count:=1 Selection.HomeKey Unit:=wdStory Do Selection.Find.ClearFormatting With Selection.Find .Text = "<h2 class=""h2"">" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Selection.Extend Selection.MoveDown Unit:=wdLine, Count:=1 Selection.Find.ClearFormatting With Selection.Find .Text = "<h2 class=""h2"">" .Replacement.Text = "" .Forward = True .Wrap = wdFindAsk .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Selection.MoveUp Unit:=wdLine, Count:=1 Selection.Cut Windows(2).Activate Selection.Paste Selection.HomeKey Unit:=wdStory Selection.HomeKey Unit:=wdLine Selection.HomeKey Unit:=wdStory Selection.EndKey Unit:=wdLine, Extend:=wdExtend Selection.Delete Unit:=wdCharacter, Count:=1 Selection.Extend Selection.MoveRight Unit:=wdCharacter, Count:=1 Selection.Find.ClearFormatting With Selection.Find .Text = "<" .Replacement.Text = "" .Forward = True .Wrap = wdFindAsk .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Selection.MoveLeft Unit:=wdCharacter, Count:=2 Selection.Copy Windows(3).Activate 'inserted here Selection.TypeParagraph Selection.Paste Selection.TypeText Text:=vbTab Windows(2).Activate Selection.HomeKey Unit:=wdStory Selection.Find.ClearFormatting With Selection.Find .Text = "<i class=""text-highlight ml-1"">-Current</i>" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute If Selection.Find.Found = True Then 'put if here Selection.HomeKey Unit:=wdLine Selection.MoveUp Unit:=wdLine, Count:=1 Selection.Find.ClearFormatting With Selection.Find .Text = """>" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Selection.MoveRight Unit:=wdCharacter, Count:=1 Selection.Extend Selection.Find.ClearFormatting With Selection.Find .Text = "<" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Selection.MoveLeft Unit:=wdCharacter, Count:=1 ' Selection.Copy Windows(3).Activate Selection.Paste Selection.TypeText Text:=vbTab Windows(2).Activate Selection.HomeKey Unit:=wdLine Selection.MoveDown Unit:=wdLine, Count:=2, Extend:=wdExtend Selection.Delete Unit:=wdCharacter, Count:=1 Selection.Find.ClearFormatting With Selection.Find .Text = "<i class=""text-highlight ml-1"">-Current</i>" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Selection.MoveUp Unit:=wdLine, Count:=1 Selection.Find.ClearFormatting With Selection.Find .Text = """>" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Selection.MoveRight Unit:=wdCharacter, Count:=1 Selection.Extend Selection.MoveRight Unit:=wdCharacter, Count:=1 Selection.Find.ClearFormatting With Selection.Find .Text = "<" .Replacement.Text = "" .Forward = True .Wrap = wdFindAsk .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Selection.MoveLeft Unit:=wdCharacter, Count:=2 Selection.MoveRight Unit:=wdCharacter, Count:=1 Selection.Copy Windows(3).Activate Selection.Paste Selection.TypeParagraph Windows(2).Activate Selection.WholeStory Selection.Delete Unit:=wdCharacter, Count:=1 End If Windows(1).Activate Loop Until Selection.Find.Found = False End Sub |
#2
|
||||
|
||||
![]()
You really shouldn't be working with windows and even more so with selections. You also have a great deal of redundant code. Even the copy/paste processes could be replaced with the FormattedText method.
See, for example: https://www.msofficeforums.com/word-...-multiple.html https://www.msofficeforums.com/word-...n-strings.html https://www.msofficeforums.com/word-...-document.html https://www.msofficeforums.com/word-...documents.html https://www.msofficeforums.com/word-...ts-length.html
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#3
|
||||
|
||||
![]()
I did have a look at your attached docs and can see that you are probably trying to extract info using the html formatting tags as your data type indicators but your methodology is overly complicated.
Using Windows(x) and selections is a quick way to complete chaos which is why I'm not going to suggest an alternative approach. I recommend you stay in the one document and simply remove anything you don't want. For example, it looks like you don't want any of the hyperlink info so strip that out. Code:
Sub RemoveLinkTags() With ActiveDocument.Range.Find .ClearFormatting .Replacement.ClearFormatting .Text = "\<a*\>" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchKashida = False .MatchDiacritics = False .MatchAlefHamza = False .MatchControl = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = True .Execute Replace:=wdReplaceAll .Text = "</a>" .MatchWildcards = False .Execute Replace:=wdReplaceAll End With End Sub
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#4
|
|||
|
|||
![]()
" trying to extract info using the html formatting tags as your data type indicators "
Yeah those are like the anchors to look for particular areas of data to extract info, since the data is very tricky once i extract the block in the 2nd window in that window i have look for >-Current</i>" in that block of data to look for current phone numbers if not found then go back to 1st window and get another record. " but your methodology is overly complicated. " It is, but it get the data out and i can later on cleanup it up more in word. The raw data file that I attached has the the following output, if there is any way to process this data internally and me without have to constantly keep pressing the hot key to keep the macro going (since the loop breaks) so i have to press the hot key again and get this data that's what i'm looking for. output data ========= Citi Bank 1000 Technology Dr, O Fallon, MO 63368 (727) 542-6974 Zuijing Liu -Current Nillie M Lau 7 Rosebank Pl, Staten Island, NY 10305 (718) 354-5270 Thanks. |
![]() |
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
Do Loop Breaking Up. | donlincolnmsof | Word VBA | 6 | 12-29-2021 02:52 PM |
![]() |
WJSwanepoel | Word VBA | 3 | 03-30-2021 11:35 PM |
![]() |
nielsgeode | Word | 13 | 08-18-2017 11:48 PM |
Equation non-breaking | mohsen.amiri | Word | 2 | 02-04-2017 12:03 AM |
Non-breaking items | judicial85 | Word | 7 | 02-23-2012 07:12 PM |