In microsoft word for replacing words with blanks

Question

I want to make a macro that will do the following:

Highlight every nth selection. Check that selection to ensure it is a word (and not numerical or punctuation). Cut the word and paste it into another document. Replace the word with a blank space. Repeat until the end of the document.

The hard part is checking a selection to validate that it is indeed a word and not something else.

I found some code written by someone else that might work, but I don't understand how to implement it in my macro with the rest of the commands:

    Function IsLetter(strValue As String) As Boolean

Dim intPos As Integer
For intPos = 1 To Len(strValue)
    Select Case Asc(Mid(strValue, intPos, 1))
        Case 65 To 90, 97 To 122
            IsLetter = True
        Case Else
            IsLetter = False
            Exit For
    End Select
Next

End Function

    Sub Blank()

Dim OriginalStory As Document
Set OriginalStory = ActiveDocument
Dim WordListDoc As Document
Set WordListDoc = Application.Documents.Add

Windows(OriginalStory).Activate

sPrompt = "How many spaces would you like between each removed word?"
sTitle = "Choose Blank Interval"
sDefault = "8"
sInterval = InputBox(sPrompt, sTitle, sDefault)

Selection.HomeKey Unit:=wdStory

Do Until Selection.Bookmarks.Exists("\EndOfDoc") = True

Selection.MoveRight Unit:=wdWord, Count:=sInterval, Extend:=wdMove
Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtend

    If IsLetter = True Then

    Selection.Cut
    Selection.TypeText Text:="__________ "
    Windows(WordListDoc).Activate
    Selection.PasteAndFormat (wdFormatOriginalFormatting)
    Selection.TypeParagraph
    Windows(OriginalStory).Activate

    Else

    Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdMove
    Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtend

    Loop

Loop

End Sub

The function should sit 'above' the rest of the code right? But I get an error 'argument not optional' when I run it.

Any ideas or tips much appreciated.

Answer 1

I think the code below will do most of what you want. Note that some of the comments relate to the reasons for which I discarded some of your code while others may prove helpful in understanding the present version.

Sub InsertBlanks()
    ' 02 May 2017

    Dim Doc As Document
    Dim WordList As Document
    Dim Rng As Range
    Dim Interval As String, Inter As Integer
    Dim Wd As String

    ' you shouldn't care which Window is active,
    ' though it probably is the one you want, anyway.
    ' The important thing is which document you work on.
'    Windows(OriginalStory).Activate
    Set Doc = ActiveDocument

    Application.ScreenUpdating = False
    Set WordList = Application.Documents.Add
    ' If you want to use all these variables you should also declare them.
    ' However, except for the input itself, they are hardly necessary.
'    sPrompt = "How many spaces would you like between each removed word?"
'    sTitle = "Choose Blank Interval"
'    sDefault = "8"
    Do
        Interval = InputBox("How many retained words would you like between removed words?", _
                            "Choose Blank Interval", CStr(8))
        If Interval = "" Then Exit Sub
    Loop While Val(Interval) < 4 Or Val(Interval) > 25
    Inter = CInt(Interval)
    ' you can modify min and max. Exit by entering a blank or 'Cancel'.

    ' You don't need to select anything.
'    Selection.HomeKey Unit:=wdStory
    Set Rng = Doc.Range(1, 1)               ' that's the start of the document
'    Set Rng = Doc.Bookmarks("James").Range  ' I used another start for my testing

    Do Until Rng.Bookmarks.Exists("\EndOfDoc") = True
        Rng.Move wdWord, Inter
        Wd = Rng.Words(1)
        If Asc(Wd) < 65 Then
            Inter = 1
        Else
            Set Rng = Rng.Words(1)
            With Rng
                ' replace Len(Wd) with a fixed number of repeats,
                ' if you don't want to give a hint about the removed word.
                .Text = String(Len(Wd) - 1, "_") & " "
                .Collapse wdCollapseEnd
            End With
            With WordList.Range
                If .Words.Count > 1 Then .InsertAfter Chr(11)
                .InsertAfter Wd
            End With
            Inter = CInt(Interval)
        End If
    Loop
    Application.ScreenUpdating = True
End Sub

In order to avoid processing non-words my above code tests, roughly, if the first character is a letter (ASCII > 64). This will preclude numbers and it will allow a lot of symbols. For example "€100" would be accepted for replacement but not "100". You may wish to refine this test, perhaps creating a function like you originally did. Another way I thought of would be to exclude "words" of less than 3 characters length. That would eliminate CrLf (if Word considers that one word) but it would also eliminate a lot of prepositions which you perhaps like while doing nothing about "€100". It's either very simple, the way I did it, or it can be quite complicated.

Answer 2

Variatus - thank you so much for this. It works absolutely perfectly and will be really useful for me.

And your comments are helpful for me to understand some of the commands you use that I am not familiar with.

I'm very grateful for your patience and help.