Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 01-18-2024, 08:29 PM
donlincolnmsof donlincolnmsof is offline Loop keeps breaking. Windows 7 64bit Loop keeps breaking. Office 2003
Advanced Beginner
Loop keeps breaking.
 
Join Date: Oct 2011
Posts: 36
donlincolnmsof is on a distinguished road
Default Loop keeps breaking.

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
Attached Files
File Type: doc logic 011824.doc (22.0 KB, 3 views)
File Type: doc sample data 011824.doc (51.5 KB, 2 views)
Reply With Quote
  #2  
Old 01-21-2024, 05:00 PM
macropod's Avatar
macropod macropod is offline Loop keeps breaking. Windows 10 Loop keeps breaking. Office 2016
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,963
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

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]
Reply With Quote
  #3  
Old 01-21-2024, 05:26 PM
Guessed's Avatar
Guessed Guessed is offline Loop keeps breaking. Windows 10 Loop keeps breaking. Office 2016
Expert
 
Join Date: Mar 2010
Location: Canberra/Melbourne Australia
Posts: 3,977
Guessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant future
Default

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
Work out how to identify the start and end of chunks that you don't want and strip them out systematically. You can replace with "^t" if you want a tab to replace a chunk you are removing.
__________________
Andrew Lockton
Chrysalis Design, Melbourne Australia
Reply With Quote
  #4  
Old 01-23-2024, 12:15 PM
donlincolnmsof donlincolnmsof is offline Loop keeps breaking. Windows 7 64bit Loop keeps breaking. Office 2003
Advanced Beginner
Loop keeps breaking.
 
Join Date: Oct 2011
Posts: 36
donlincolnmsof is on a distinguished road
Default

" 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.
Reply With Quote
Reply



Similar Threads
Thread Thread Starter Forum Replies Last Post
Do Loop Breaking Up. donlincolnmsof Word VBA 6 12-29-2021 02:52 PM
Loop keeps breaking. Getting rid of Non-breaking space WJSwanepoel Word VBA 3 03-30-2021 11:35 PM
Loop keeps breaking. non-breaking ] and [ 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

Other Forums: Access Forums

All times are GMT -7. The time now is 09:13 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2024, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2024 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft