Hi everybody,
I should start apologizing if my question is too stupid, I am a legal editor and have been self-learning VBA to let machines do my work basically. I have been struggling with this code to run several wildcard searches and copy whatever is found in a new document. When I debug the code works perfectly, but if I run it, it stops halfway in the second loop in Find.execute. I would be eternally grateful if anyone can have a look at it. Most of my macros follow this principle of finding something and copying into a new document, so fixing this would make such a big difference for me:
'Creates a new document with a list of all the disputes cited in the footnotes
Dim rngsource As Range
If ActiveDocument.Footnotes.Count > 0 Then
Set rngsource = ActiveDocument.Footnotes(1).Range
rngsource.WholeStory
End If
Dim strSource As String
Dim strDestination As String
strSource = ActiveWindow.Caption
Documents.Add
strDestination = ActiveWindow.Caption
Dim rngdestination As Range
Set rngdestination = Windows(strDestination).Selection.Range
rngdestination.WholeStory
Windows(strSource).Activate
rngsource.Select
' this is my first loop, once selected the source document. this one works fine and ends when is done
Selection.Find.ClearFormatting
Selection.Find.Text = "Panel Report,[!^013]@[;,]"
Selection.Find.MatchWildcards = True
Selection.Find.Execute
Do While Selection.Find.Found
Selection.Copy
Selection.MoveRight Unit:=wdCharacter, _
Count:=1, Extend:=wdMove
Windows(strDestination).Activate
Selection.EndKey Unit:=wdStory
Selection.Paste
Selection.TypeParagraph
Windows(strSource).Activate
Selection.Find.Execute
Loop
' second loop. It works for a while and then stops halfway
Windows(strSource).Activate
rngsource.Select
Selection.Find.ClearFormatting
Selection.Find.Text = "Appellate[^032^s]Body Report,[!^013]@[;,]"
Selection.Find.MatchWildcards = True
Selection.Find.Execute
Do While Selection.Find.Found
Selection.Copy
Selection.MoveRight Unit:=wdCharacter, _
Count:=1, Extend:=wdMove
Windows(strDestination).Activate
Selection.EndKey Unit:=wdStory
Selection.Paste
Selection.TypeParagraph
Windows(strSource).Activate
Selection.Find.Execute
Loop
Windows(strSource).Activate
' third loop. I only get this far when I debug
rngsource.Select
Selection.Find.ClearFormatting
Selection.Find.Text = "Panel Reports,[!^013]@[.:]^013"
Selection.Find.MatchWildcards = True
Selection.Find.Execute
Do While Selection.Find.Found
Selection.Copy
Selection.MoveRight Unit:=wdCharacter, _
Count:=1, Extend:=wdMove
Windows(strDestination).Activate
Selection.EndKey Unit:=wdStory
Selection.Paste
Selection.TypeParagraph
Windows(strSource).Activate
Selection.Find.Execute
Loop
Windows(strSource).Activate
rngsource.Select
Selection.Find.ClearFormatting
Selection.Find.Text = "Appellate[^032^s]Body Reports,[!^013]@[.:]^013"
Selection.Find.MatchWildcards = True
Selection.Find.Execute
Do While Selection.Find.Found
Selection.Copy
Selection.MoveRight Unit:=wdCharacter, _
Count:=1, Extend:=wdMove
Windows(strDestination).Activate
Selection.EndKey Unit:=wdStory
Selection.Paste
Selection.TypeParagraph
Windows(strSource).Activate
Selection.Find.Execute
Loop
Windows(strSource).Activate
rngsource.Select
Selection.Find.ClearFormatting
Selection.Find.Text = "Panel Reports,[!^013]@[.:]^032^013"
Selection.Find.MatchWildcards = True
Selection.Find.Execute
Do While Selection.Find.Found
Selection.Copy
Selection.MoveRight Unit:=wdCharacter, _
Count:=1, Extend:=wdMove
Windows(strDestination).Activate
Selection.EndKey Unit:=wdStory
Selection.Paste
Selection.TypeParagraph
Windows(strSource).Activate
Selection.Find.Execute
Loop
Windows(strSource).Activate
rngsource.Select
Selection.Find.ClearFormatting
Selection.Find.Text = "Appellate[^032^s]Body Reports,[!^013]@[.:]^032^013"
Selection.Find.MatchWildcards = True
Selection.Find.Execute
Do While Selection.Find.Found
Selection.Copy
Selection.MoveRight Unit:=wdCharacter, _
Count:=1, Extend:=wdMove
Windows(strDestination).Activate
Selection.EndKey Unit:=wdStory
Selection.Paste
Selection.TypeParagraph
Windows(strSource).Activate
Selection.Find.Execute
Loop
End Sub
Thanks so so much!!
I should start apologizing if my question is too stupid, I am a legal editor and have been self-learning VBA to let machines do my work basically. I have been struggling with this code to run several wildcard searches and copy whatever is found in a new document. When I debug the code works perfectly, but if I run it, it stops halfway in the second loop in Find.execute. I would be eternally grateful if anyone can have a look at it. Most of my macros follow this principle of finding something and copying into a new document, so fixing this would make such a big difference for me:
'Creates a new document with a list of all the disputes cited in the footnotes
Dim rngsource As Range
If ActiveDocument.Footnotes.Count > 0 Then
Set rngsource = ActiveDocument.Footnotes(1).Range
rngsource.WholeStory
End If
Dim strSource As String
Dim strDestination As String
strSource = ActiveWindow.Caption
Documents.Add
strDestination = ActiveWindow.Caption
Dim rngdestination As Range
Set rngdestination = Windows(strDestination).Selection.Range
rngdestination.WholeStory
Windows(strSource).Activate
rngsource.Select
' this is my first loop, once selected the source document. this one works fine and ends when is done
Selection.Find.ClearFormatting
Selection.Find.Text = "Panel Report,[!^013]@[;,]"
Selection.Find.MatchWildcards = True
Selection.Find.Execute
Do While Selection.Find.Found
Selection.Copy
Selection.MoveRight Unit:=wdCharacter, _
Count:=1, Extend:=wdMove
Windows(strDestination).Activate
Selection.EndKey Unit:=wdStory
Selection.Paste
Selection.TypeParagraph
Windows(strSource).Activate
Selection.Find.Execute
Loop
' second loop. It works for a while and then stops halfway
Windows(strSource).Activate
rngsource.Select
Selection.Find.ClearFormatting
Selection.Find.Text = "Appellate[^032^s]Body Report,[!^013]@[;,]"
Selection.Find.MatchWildcards = True
Selection.Find.Execute
Do While Selection.Find.Found
Selection.Copy
Selection.MoveRight Unit:=wdCharacter, _
Count:=1, Extend:=wdMove
Windows(strDestination).Activate
Selection.EndKey Unit:=wdStory
Selection.Paste
Selection.TypeParagraph
Windows(strSource).Activate
Selection.Find.Execute
Loop
Windows(strSource).Activate
' third loop. I only get this far when I debug
rngsource.Select
Selection.Find.ClearFormatting
Selection.Find.Text = "Panel Reports,[!^013]@[.:]^013"
Selection.Find.MatchWildcards = True
Selection.Find.Execute
Do While Selection.Find.Found
Selection.Copy
Selection.MoveRight Unit:=wdCharacter, _
Count:=1, Extend:=wdMove
Windows(strDestination).Activate
Selection.EndKey Unit:=wdStory
Selection.Paste
Selection.TypeParagraph
Windows(strSource).Activate
Selection.Find.Execute
Loop
Windows(strSource).Activate
rngsource.Select
Selection.Find.ClearFormatting
Selection.Find.Text = "Appellate[^032^s]Body Reports,[!^013]@[.:]^013"
Selection.Find.MatchWildcards = True
Selection.Find.Execute
Do While Selection.Find.Found
Selection.Copy
Selection.MoveRight Unit:=wdCharacter, _
Count:=1, Extend:=wdMove
Windows(strDestination).Activate
Selection.EndKey Unit:=wdStory
Selection.Paste
Selection.TypeParagraph
Windows(strSource).Activate
Selection.Find.Execute
Loop
Windows(strSource).Activate
rngsource.Select
Selection.Find.ClearFormatting
Selection.Find.Text = "Panel Reports,[!^013]@[.:]^032^013"
Selection.Find.MatchWildcards = True
Selection.Find.Execute
Do While Selection.Find.Found
Selection.Copy
Selection.MoveRight Unit:=wdCharacter, _
Count:=1, Extend:=wdMove
Windows(strDestination).Activate
Selection.EndKey Unit:=wdStory
Selection.Paste
Selection.TypeParagraph
Windows(strSource).Activate
Selection.Find.Execute
Loop
Windows(strSource).Activate
rngsource.Select
Selection.Find.ClearFormatting
Selection.Find.Text = "Appellate[^032^s]Body Reports,[!^013]@[.:]^032^013"
Selection.Find.MatchWildcards = True
Selection.Find.Execute
Do While Selection.Find.Found
Selection.Copy
Selection.MoveRight Unit:=wdCharacter, _
Count:=1, Extend:=wdMove
Windows(strDestination).Activate
Selection.EndKey Unit:=wdStory
Selection.Paste
Selection.TypeParagraph
Windows(strSource).Activate
Selection.Find.Execute
Loop
End Sub
Thanks so so much!!