none
VBA find.replace.execute loops when replacing multiple paragraph marks RRS feed

  • Question

  • The following code is intended to replace duplicate paragraph marks in a document:

    Sub BWordSqueezeParagraphMarks(xDoc As Document)
    
     Dim found As Boolean
    
     With xDoc.Content.Find
    
      .Text = "^p^p"
    
      found = .Execute
    
     End With
    
     While found
    
      With xDoc.Content.Find
    
       .Text = "^p^p"
    
       .Replacement.Text = "^p"
    
       found = .Execute(Replace:=wdReplaceAll)
    
      End With
    
     Wend
    
    End Sub
    
    Sub z()
    
     Call BWordSqueezeParagraphMarks(Documents("Many repeated paragraph marks.doc"))
    
    End Sub

    It works fine so long as the last paragraph in a document has some text. If it does not, the macro loops until cancelled with Ctrl Break.

    I have placed a document containing the code, and a document which can be used to investigate the problem, at http://cid-75e3e350f569b887.office.live.com/self.aspx/.Public/VBA%20loop%20in%20Word%20find.execute.

    The problem was encountered with Word 2010 32 bit under Windows 7 64 bit. No other combinations have yet been tested.

    • Edited by Julian Ladbury Monday, January 17, 2011 11:12 PM Clarify description about loop
    Monday, January 17, 2011 5:50 PM

Answers

  • Hi Julian,

    You can ensure there's no empty last paragraph by using:

    Sub BWordSqueezeParagraphMarks(xDoc As Document)
    With xDoc
      With .Content.Find
        .Text = "[^13]{2,}"
        .Replacement.Text = "^p"
        .MatchWildcards = True
        .Execute Replace:=wdReplaceAll
       End With
       .Characters.Last.Delete
    End With
    End Sub


    Cheers
    Paul Edstein
    [MS MVP - Word]
    • Marked as answer by Julian Ladbury Tuesday, January 18, 2011 12:43 PM
    Tuesday, January 18, 2011 2:04 AM

All replies

  • hi julian,

    You don't need a loop. Try:

    Sub BWordSqueezeParagraphMarks(xDoc As Document)
      With xDoc.Content.Find
        .Text = "[^13]{2,}"
        .Replacement.Text = "^p"
        .MatchWildcards = True
        .Execute Replace:=wdReplaceAll
       End With
    End Sub

    The above code will replace all instances of two or more paragraph breaks with a single paragraph break.


    Cheers
    Paul Edstein
    [MS MVP - Word]
    Monday, January 17, 2011 9:07 PM
  • Paul,

    Thanks for this suggestion. I obviously need to learn more about using expressions in the Find object! A job for tomorrow.

    I have clarified my original description by mentioning that the loop which I encounter is one which has to be interrupted with Ctrl Break. The 'found' variable never gets set to False if the last paragraph contains no text.

    The code you suggest does indeed prevent that endless loop, but fails to remove the final paragraph mark if it contains no text (this is probably connected with the above-mentioned problem about the 'found' variable always being True in my code).

    Your code will almost certainly suit my purposes - thanks once again - but I suspect there is nevertheless some underlying problem. I would appreciate any further comments anyone has about that.
    Monday, January 17, 2011 11:31 PM
  • Hi Julian,

    You can ensure there's no empty last paragraph by using:

    Sub BWordSqueezeParagraphMarks(xDoc As Document)
    With xDoc
      With .Content.Find
        .Text = "[^13]{2,}"
        .Replacement.Text = "^p"
        .MatchWildcards = True
        .Execute Replace:=wdReplaceAll
       End With
       .Characters.Last.Delete
    End With
    End Sub


    Cheers
    Paul Edstein
    [MS MVP - Word]
    • Marked as answer by Julian Ladbury Tuesday, January 18, 2011 12:43 PM
    Tuesday, January 18, 2011 2:04 AM
  • Paul,

    Perfect! That does exactly what I want. I have tested it successfully in Word 2000 and in Word 2010, and assume it will therefore be fine with versions in between.

    Many thanks for your help and speedy response.

    Julian

    Tuesday, January 18, 2011 12:43 PM