Word: Replace spaces with indents

Sometimes you need to replace spaces with tabs to make nice indented lists. But if you use tabs, then if the line overflows, it looks bad because the words spill back to the start of the line:

   Item 1 

      Sub item 1.1 

         Sub-sub item 1.1.1 with 

really long text   <-- o no it spilled to the start of the line ruining the indents

         Sub-sub item 1.1.2

The better way is to change the indent of the paragraph. But there's no easy way to do this in Word, short of manually adding indents, or adding a style for each level and doing lots of find and replaces (which actually is also a good alternative solution come to think of it).

Here is a macro that works on a selection to do some smart find and replace. It incorporates some nice features like progressively reducing the search range. I found out that Word redefines the range after it finds something - you don't need to use selection.find, you can use range.find. BUT there is an undocumented behaviour of Find function means that you need to reset the range.find each time if you change the start or end of a found range.

It also shows how to turn off screen updating and turn it back in in the event of an error (thanks to the interwebs for showing me how to do that).


Sub ConvertSpacesToIndents()

    ' Converts triple spaces to indents (skipping the first triple indent)

    

    On Error GoTo Error


    Application.ScreenUpdating = False

    

    Dim scope As Range      ' The original selection

    Dim found As Boolean    ' Flag saying that the word has been found

    Dim foundRange As Range ' Where the word had been found currently

    Dim startHere As Range ' Keeps track of where Word is up to in the search

    

    Set scope = Selection.Range

    Set foundRange = Selection.Range

    

    With foundRange.Find

        .ClearFormatting

        .text = "   "

        .Forward = True

        .Wrap = wdFindStop

        .Format = False

    End With

    

    found = foundRange.Find.Execute ' https://learn.microsoft.com/en-us/office/vba/api/word.find

                                    ' If you've gotten to the Find object from the Range object,

                                    ' the selection isn't changed when text matching the find criteria

                                    ' is found, but the Range object is redefined.

    

    While (found)

        foundRange.text = "" ' Delete the text

        If foundRange.Characters(1) <> " " Then

            ' Do nothing, this is to ignore the first level of spaces.

            ' You can remove this entire If statement if you want all the spaces to turn into indents

            ' and just leave the line in the "Else" section.

        Else

            foundRange.Paragraphs.LeftIndent = foundRange.Paragraphs.LeftIndent + 5 ' Increase indent by 5 pts

        End If

        ' scope.Select

        foundRange.Collapse (wdCollapseEnd) ' Go to the end of the found text

        Set startHere = foundRange          ' Store the new starting position (which is just after what was found)

        Set foundRange = scope ' Set the range back to the original selection since

                               ' foundrange currently points to the blanked text location

        foundRange.Start = startHere.Start ' Reset the starting position to where the last search was found

        With foundRange.Find ' Undocumented behaviour of Find function means that you

                             ' need to reset the range each time if you change the

                             ' start or end of a found range.

            .ClearFormatting

            .text = "   "

            .Forward = True

            .Wrap = wdFindStop

            .Format = False

        End With

        found = foundRange.Find.Execute

    Wend

    Application.ScreenRefresh 

    Application.ScreenUpdating = True

    MsgBox "Success!", vbInformation


Exit_Sub:

    Exit Sub


Error:

    Application.ScreenUpdating = True

    ' Regenerate original error.

    Dim intErrNum As Integer

    intErrNum = Err

    Err.Clear

    Err.Raise intErrNum

End Sub