Find and Replace until it finds 0 instances 2

[dodge20]

I have a macro that I would like to run the find and replace until it doesn't find anything to replace. I notice that when I try to replace 2 spaces with 1, I need to run this multiple times depending on the document. I would like to loop through until it doesn't find anything more to replace. I am not sure how to go about doing this. Any help will be appreciated.

Sub PrepareRelease()

    ActiveDocument.SaveAs FileName:="Release.txt", FileFormat:=wdFormatText, _
        LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _
        :="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
        SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
        False, Encoding:=20127, InsertLineBreaks:=False, AllowSubstitutions:=True _
        , LineEnding:=wdCRLF
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^t"
        .Replacement.Text = " "
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    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 Replace:=wdReplaceAll
    With Selection.Find
        .Text = "^p "
        .Replacement.Text = "^p"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub
[code]

Also is there a way to get this to prompt to enter a file name istead of always saving it as Release.txt?

Dodge20

 

[ThomasLafferty]

Hi Dodge20!
To prompt for new file name:

Sub PrepareRelease()
[!]Dim strFileName As String
strFileName = InputBox$("Enter a new name for this Document.","Save As")[/!]
ActiveDocument.SaveAs FileName:=[!]strFileName[/!],

Add the items in red to your code.

Live once die twice; live twice die once.

 

[TonyJollans]

To replace any number of spaces with a single space, use wildcards ...

[blue]    With Selection.Find
        .Text = [red]" {2,}"[/red]
        .Replacement.Text = " "
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = [red]True[/red]
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
[/blue]

Enjoy,
Tony

--------------------------------------------------------------------------------------------
We want to help you; help us to do it by reading this: Before you ask a question.

Professional Office Developers Association

 

[dodge20]

Thanks guys.

The spaces were an example - I would like it so all 3 of the replacements that I am doing will go until there are no more instances. Same approach to make that happen?

ThomasLafferty is there a way to specify where the file is saved? Right now that code just puts it into my documents.

Dodge20

 

[ThomasLafferty]

Sure!
Add the items in red:

[!]Dim strPath as String
strPath = "C:\Folder\Subfolder\etc.\etc.\"[/!]
strFileName = InputBox$("Enter a new name for this Document.","Save As")
ActiveDocument.SaveAs FileName:=[!]strPath & [/!]strFileName,

You will of course have to know the correct path to where you want it to be saved...
Tom

Live once die twice; live twice die once.

 

[TonyJollans]

Yes the approach is the same.

The tabs are straightforward as you have them - a single execution will do all of them. To replace a paragraph followed by a number of spaces replace (all) "^13 {1,}" with "^p" (note the ^13 to find paragraphs when you use widcards). Alternatively replace the spaces first then all you will find will be "^p " and you won't need the wildcard.

Enjoy,
Tony

--------------------------------------------------------------------------------------------
We want to help you; help us to do it by reading this: Before you ask a question.

Professional Office Developers Association

 

[dodge20]

Thanks

It works well.

Dodge20