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

	logic 011824.doc (22.0 KB, 5 views)
	sample data 011824.doc (51.5 KB, 4 views)