Word crashes if I run a macro that does too much.

[Helen269]

I've noticed that if I run a macro that has a big file to work on or has a lot of work to do even in a small file then Word will crash. This may be something to do with the fact that I'm on a 32bit machine bugt I can't afford to upgrade and modernise. Is there a command I can add to my macros to make them pause after each loop so my poor old machine can "catch its breath" and be able to run through any size of Word file without breaking down and crying?

Typically, I have a macro that will look for blank lines and delete them so it loops over the same code many times. Too many blank lines in one block or too big a file and it crashes.

[Kilroy]

Helen I have a quick machine and still have this problem. I started using a simple find replace for multiple returns in a row. Problem was solved. Although if the document is 500+ pages it still kind of chokes up. With it I never have more than one space between paragraphs.

Sub Replace3returnsWith2()

Selection.WholeStory
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.text = "^13{3,}"
.Replacement.text = "^p^p"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
.Execute Replace:=wdReplaceAll
End With
End Sub

If you don't wan any space between paragraphs remove one of the "^P" from the replacement text line. Good luck.

[Helen269]

Well, here's the actual code that gives me the problem:

' delete empty speaker and next line
Application.ScreenUpdating = False
Selection.HomeKey Unit:=wdStory
With Selection.Find
.ClearFormatting
.Wrap = wdFindStop
.Text = ":^t^p^t^p"
Do While .Execute
ActiveDocument.Bookmarks("\Line").Range.Delete
ActiveDocument.Bookmarks("\Line").Range.Delete
Loop
End With
Application.ScreenUpdating = True


It turns this:

SPEAKER1: Says something.

SPEAKER2:

SPEAKER3:

SPEAKER4: Says something.

into this:

SPEAKER1: Says something.

SPEAKER4: Says something.


If there's two or more speakers who say nothing then I have to go through and delete them manually but if there's just one empty speaker between two speakers who do say something then it runs fine.

[Kilroy]

Try this:

Sub RemoveEmptyLines()
Selection.WholeStory
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.text = "Speaker^#:^p"
.Replacement.text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = False
.Execute Replace:=wdReplaceAll
End With
End Sub

[Helen269]

I'm afraid that didn't work, at least not for me. Where it says "Speaker" in my sample text, I mean that it will have different people's name that change from document to document. So how can I make a wildcard version of
.text = "Speaker^#:^p"

that will work with any random name plus a colon?

SMITH:<tab><p>
<empty line>
JONES:<tab><p>
<empty line>

[Kilroy]

Try this. It gives you 4 input boxes put one name in each only. If you have more than 4 speakers you could run it twice or add more input boxes.

Sub Delete()
Dim arr() As Variant
Dim i As Byte
'Kilroy
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
arr = Array(InputBox("Enter Name") & ":^p", InputBox("Enter Name") & ":^p", InputBox("Enter Name") & ":^p", InputBox("Enter Name") & ":^p")
  For i = LBound(arr) To UBound(arr)
    With Selection.Find
      .text = arr(i)
      .Replacement.text = ""
      .Forward = True
      .Wrap = wdFindContinue

    End With
  Selection.Find.Execute Replace:=wdReplaceAll
  Next
End Sub

[Helen269]

Sorry, that doesn't do anything. Anyway, don't worry about it, it's no great hardship to do it by hand, I just wondered if it could be made just a little easier, that's all. Thank you for your efforts but I think I'll just do it manually. Cheers.

[Kilroy]

I just ran it on a 1200 page document and it worked perfectly. Removed every line that didn't have anything after the :. Not sure why it doesn't work for you. If you post an actual document with names changed and any private in formation it would be a lot easier to figure out. Is there a tab (^t) between the : and the end of the paragraph marker?

[Kilroy]

If there is a tab try this:

Sub Delete()
Dim arr() As Variant
Dim i As Byte
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
arr = Array(InputBox("Enter Name") & ":^t^p", InputBox("Enter Name") & ":^t^p", InputBox("Enter Name") & ":^t^p", InputBox("Enter Name") & ":^t^p")
  For i = LBound(arr) To UBound(arr)
    With Selection.Find
      .text = arr(i)
      .Replacement.text = ""
      .Forward = True
      .Wrap = wdFindContinue
    End With
  Selection.Find.Execute Replace:=wdReplaceAll
  Next
End Sub

[Helen269]

Ah, yes, that worked. I did change the search line, though, to fit with my document. It's now:
arr = Array(InputBox("Enter Name") & ":^t^p^t^p")
This ensures that both the speaker's line and the line below it are erased.

Many thanks! :-)

[macropod]

Try:

Sub Demo()
Application.ScreenUpdating = False
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "^13[!^13:]@:[!0-9A-Za-z]@^13"
    .Replacement.Text = "^p"
    .Forward = True
    .Format = False
    .Wrap = wdFindContinue
    .MatchWildcards = True
    .Execute
    Do While .Found = True
      .Execute Replace:=wdReplaceAll
      DoEvents
    Loop
  End With
End With
Application.ScreenUpdating = True
End Sub

[Helen269]

Thanks, Paul. I can see that that works even in a large document. What do I need to do to the "^13[!^13:]@:[!0-9A-Za-z]@^13" bit to make it include the next line below it to be replaced by the "^p"? So if, in a transcript, a person has not said anything then I need the line with their placeholder name, and the blank line below it, to both be deleted.

[macropod]

The code I posted already does that. Unless you have multiple consecutive empty paragraphs, all you should end up with is the 'active' speakers and an empty paragraph between them. If you do have such multiple empty paragraphs, you might change:
.Text = "^13[!^13:]@:[!0-9A-Za-z]@^13"
to:
.Text = "^13[!^13:]@:[!0-9A-Za-z]@^13{1,}"

[Helen269]

Ah yes, that works. Thank you! :-)