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
|