Microsoft Office Forums

Go Back   Microsoft Office Forums > >
Reload this Page Do Loop Breaking Up.
Register FAQ

 
 
Thread Tools Display Modes
Prev Previous Post   Next Post Next
  #1  
Old 12-02-2021, 12:40 PM
donlincolnmsof donlincolnmsof is offline Do Loop Breaking Up. Windows 7 64bit Do Loop Breaking Up. Office 2003
Advanced Beginner
Do Loop Breaking Up. 		 
Join Date: Oct 2011
Posts: 36
donlincolnmsof is on a distinguished road
Default Do Loop Breaking Up.
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.

Any help will be greatly appreciated.

Thanks.



Sub Macro4()
'
' Macro4 Macro
' Macro recorded 11/26/2021 by don
'


Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "<!doctype html>"
.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.MoveRight Unit:=wdCharacter, Count:=1
Selection.Find.ClearFormatting
With Selection.Find
.Text = "</html>"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.Cut

'2nd window

Windows(2).Activate
Selection.WholeStory
Selection.Paste


'1st do

Do

Selection.HomeKey Unit:=wdStory
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

If Selection.Find.Found = True Then

Selection.Copy

'3rd window

Windows(3).Activate
Selection.Paste
Selection.TypeText Text:=vbTab
Windows(2).Activate
Selection.Delete Unit:=wdCharacter, Count:=1

Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "<title>"
.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.MoveRight Unit:=wdCharacter, Count:=1
Selection.Find.ClearFormatting
With Selection.Find
.Text = "</title>"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.Copy
Windows(3).Activate
Selection.Paste
Selection.TypeParagraph
Windows(2).Activate

End If

Loop Until Selection.Find.Found = False


'2nd do

Do

Selection.HomeKey Unit:=wdStory
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

If Selection.Find.Found = True Then

Selection.Copy

'3rd window

Windows(3).Activate
Selection.Paste
Selection.TypeText Text:=vbTab
Windows(2).Activate
Selection.Delete Unit:=wdCharacter, Count:=1

Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "<title>"
.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.MoveRight Unit:=wdCharacter, Count:=1
Selection.Find.ClearFormatting
With Selection.Find
.Text = "</title>"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.Copy
Windows(3).Activate
Selection.Paste
Selection.TypeParagraph
Windows(2).Activate

End If

Loop Until Selection.Find.Found = False

'3rd do

Do

Selection.HomeKey Unit:=wdStory
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

If Selection.Find.Found = True Then

Selection.Copy

'3rd window

Windows(3).Activate
Selection.Paste
Selection.TypeText Text:=vbTab
Windows(2).Activate
Selection.Delete Unit:=wdCharacter, Count:=1

Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "<title>"
.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.MoveRight Unit:=wdCharacter, Count:=1
Selection.Find.ClearFormatting
With Selection.Find
.Text = "</title>"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.Copy
Windows(3).Activate
Selection.Paste
Selection.TypeParagraph
Windows(2).Activate

End If



Loop Until Selection.Find.Found = False

'1st window

Windows(1).Activate

End Sub
Reply With Quote
 

« Previous Thread | Next Thread »


Similar Threads
Thread Thread Starter Forum Replies Last Post
Do Loop Breaking Up. Getting rid of Non-breaking space WJSwanepoel Word VBA 3 03-30-2021 11:35 PM
Do Loop Breaking Up. 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
Do Loop Breaking Up. Breaking up a mergefield into parts WillTRiker Mail Merge 1 07-10-2015 01:58 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 01:10 PM.

Contact Us - Privacy Statement - Top

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