Replacing till there's no more double paragraphs in the text

eduzs · #1 06-24-2017, 02:22 PM

Search for "^p^p" and replace with "^p" loop this until it no find any one more "^p^p" in the active document.

I have this code:

(it's not working, its resulting in freeze/loop/crash word)

Dim oRng As Range

Set oRng = ActiveDocument.Range

With oRng.Find

.Wrap = wdFindStop

Do While .Execute(FindText:="^p^p",replacewith:="^p")

Loop

End With

gmaxey · #2 06-24-2017, 05:26 PM

Code:

Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim oRng As Range
  Set oRng = ActiveDocument.Range
  With oRng.Find
      .Text = "^13{2,}"
      .Replacement.Text = "^p"
      .MatchWildcards = True
      .Execute Replace:=wdReplaceAll
    End With
lbl_Exit:
  Exit Sub
End Sub

eduzs · #3 06-24-2017, 05:51 PM

Thanks gmaxey
Cause I don't now how many ^p^p^p... the text have, my macro should keep changing ^p^p to ^p till there's no more "^p^p", but just "^p", your code seems to do a single find and replace.

Dim oRng As Range

Set oRng = ActiveDocument.Range

Application.ScreenUpdating = False

With oRng.Find

.Text = "^13{2}" (I got a error with "2," so I removed the ,")
.Replacement.Text = "^p"
.MatchWildcards = True
.Execute

End With

eduzs · #4 06-24-2017, 05:59 PM

I returned to this version of my code:

This should be a bug of word vba? I found that the loop/crash ocurrs only when theres a ^p^p at the end of the document.

Sub Limpa_texto()

Application.ScreenUpdating = False

ActiveDocument.Select

With Selection

With .Find

.Text = "^13{2}"
.Replacement.Text = "^13"
.Forward = True
.MatchWildcards = True
.Wrap = wdFindStop
.Execute

End With

Do While .Find.Found

.Find.Execute Replace:=wdReplaceAll

Loop

End With

Application.ScreenUpdating = True

End Sub

gmaxey · #5 06-24-2017, 06:12 PM

Replace the comma in 2, with whatever the list separator character is for your system.

eduzs · #6 06-24-2017, 07:02 PM

Still get the freeze/crash word when there's "^p^p" at the end of the document.
I'm looking for a workaround to this, also get sometimes "Code execution aborted" message without error.
Maybe instead of search active document use selection.wholestory and move the selection to exclude the last character of the document.
Or add a code to remove the last char of the document when it's "^p^p" before run the rest of the code.

gmayor · #7 06-24-2017, 08:20 PM

The macro doesn't remove an empty paragraph at the end of the document, but that's easily fixed

Code:

Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
'Graham Mayor - http://www.gmayor.com - Last updated - 25 Jun 2017
Dim oRng As Range
    Set oRng = ActiveDocument.Range
    With oRng.Find
        .Text = "^13{2;}" 'Note the list separator character - here ;
        .Replacement.Text = "^p"
        .MatchWildcards = True
        .Execute Replace:=wdReplaceAll
    End With
    If Len(ActiveDocument.Range.Paragraphs.Last.Range) = 1 Then
        ActiveDocument.Range.Paragraphs.Last.Range.Delete
    End If
lbl_Exit:
    Exit Sub
End Sub

eduzs · #8 06-24-2017, 08:38 PM

Thanks for helping, based on your idea we got a workaround to this "bug":

Now I can get rid of unwanted paragraphs breaks and repeated blankspaces.

Code:

Sub Limpa_texto()

Dim i As Integer, oRng As Range, aProc, aSubs

aProc = Array("^13{2;}", "^32{2;}", "^13^32")
aSubs = Array("^p", " ", "^p")

Set oRng = ActiveDocument.Range

Do While Len(ActiveDocument.Range.Paragraphs.Last.Range) = 1

    ActiveDocument.Range.Paragraphs.Last.Range.Delete

Loop

Application.ScreenUpdating = False

For i = 0 To UBound(aProc)

    With oRng.Find

        .Text = aProc(i)
        .Replacement.Text = aSubs(i)
        .Forward = True
        .MatchWildcards = True
        .Wrap = wdFindContinue
        .Execute
        
    End With

    Do While oRng.Find.Found

        oRng.Find.Execute Replace:=wdReplaceAll

    Loop

Next i
    
Application.ScreenUpdating = True

End Sub

gmaxey · #9 06-25-2017, 05:47 AM

Graham, thanks!

Break

eduzs,

I'm not entirely sure that I know what your goal really is, but if it is to remove empty paragraphs and leading or trailing spaces from paragraphs then I think your current version falls short.

And to each his own and perhaps it is due to habit or what you have seen before, but I can't for the life of me see any advantage of your two Do ... While loops or use of the seemingly redundant Find.Found.

Code:

Sub Limpa_texto()
Dim lngIndex As Long, oRng As Range
Dim strLS As String
Dim arrFind, arrReplace
  strLS = Application.International(wdListSeparator)
  arrFind = Array("^32{1,}^13", "^13^32{1,}", "^13{2,}", "^32{2,}")
  arrReplace = Array("^p", "^p", "^p", " ")
  Set oRng = ActiveDocument.Range
  Application.ScreenUpdating = False
  For lngIndex = 0 To UBound(arrFind)
    With oRng.Find
      .Text = Replace(arrFind(lngIndex), ",", strLS)
      .Replacement.Text = Replace(arrReplace(lngIndex), ",", strLS)
      .MatchWildcards = True
      .Execute Replace:=wdReplaceAll
    End With
  Next lngIndex
  If Len(ActiveDocument.Range.Paragraphs.Last.Range) = 1 Then
    ActiveDocument.Range.Paragraphs.Last.Range.Delete
  End If
  Application.ScreenUpdating = True
lbl_Exit:
  Exit Sub
End Sub

eduzs · #10 06-25-2017, 05:52 AM

Thanks!
I explain, in the text I have "pp", "ppp", "ppppp".... I don't know how many in sequence, and I need to change all this to a only one "p", so I (by what I know) can't do a single find and replace "pp" to "p".
So the code is keeping "pppp", "ppppp" in the document
Is there a wildcard that replace a unknown number sequence of repeated "^p" to a single "^p", or, another aproach, delete all len(p)=1 paragraphs?

gmaxey · #11 06-25-2017, 05:59 AM

I had my doubts that you had tested the code before. If you had you might have been left with two paragraphs at the end of the document but Word would not have crashed or been stuck in a loop.

eduzs · #12 06-25-2017, 06:13 AM

Your code works fine, but I'm testing it in a complex html page pasted in word, I'm working to know what's the problem.
Thanks a lot for helping.

what's means "{2,}" ?

gmaxey · #13 06-25-2017, 06:28 AM

It means two or more instances of the preceding defined character
e.g., a{2,} will find aa, aaa, aaaa, etc., but it won't find a.

eduzs · #14 06-25-2017, 06:31 AM

I found just a minor problem, when ^p^p^p... is followed by a table it's not replacing these occurrences.

gmaxey · #15 06-25-2017, 06:43 AM

Code:

Sub Limpa_texto()
Dim lngIndex As Long, oRng As Range
Dim strLS As String
Dim arrFind, arrReplace
  strLS = Application.International(wdListSeparator)
  arrFind = Array("^32{1,}^13", "^13^32{1,}", "^13{2,}", "^32{2,}")
  arrReplace = Array("^p", "^p", "^p", " ")
  Set oRng = ActiveDocument.Range
  Application.ScreenUpdating = False
  For lngIndex = 0 To UBound(arrFind)
    With oRng.Find
      .Text = Replace(arrFind(lngIndex), ",", strLS)
      .Replacement.Text = Replace(arrReplace(lngIndex), ",", strLS)
      .MatchWildcards = True
      .Execute Replace:=wdReplaceAll
    End With
  Next lngIndex
  'Deal with dispersed tables and final paragraph.
  For lngIndex = ActiveDocument.Range.Paragraphs.Count To 1 Step -1
    If Len(ActiveDocument.Range.Paragraphs(lngIndex).Range.Text) = 1 Then
      ActiveDocument.Range.Paragraphs(lngIndex).Range.Delete
    End If
  Next
  Application.ScreenUpdating = True
lbl_Exit:
  Exit Sub
End Sub

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Help with replacing text with wildcards	sbatson5	Word	2	04-13-2012 03:49 AM
Why the "Text boundaries" are not shown till the end of the page while in other file	Jamal NUMAN	Word	4	03-28-2012 07:58 AM
outlook double spacing paragraphs	GWBDIRECT	Outlook	3	04-06-2011 11:29 AM
Replacing a single "l" with a double "ll"	MShroff	Word	8	01-19-2011 08:43 AM
Replacing / editting text	LisaC	Word	0	02-25-2010 03:40 AM