Macro for acronyms in Word 2013

I am by no means a macro expert. My macro skills are rudimentary, much to my own frustration. However, I recently spent some time to develop a macro to automatically create an acronyms list in Word 2013, which I've been wanting to do for a long time.

First the basic steps to get started.

1. As you come across a defined acronym in your document, highlight the definition and acronym. (In the tech writing world, we define acronyms the first time utilizing this format: "Common Configuration Enumerations (CCE)." For this macro, you'll highlight everything that's similar to the text in quotes.)
2. Click the References tab on the menu, and click Mark Entry in the Index group.
3. Leave the defaults in the form box and click Mark.
4. Once you've marked all the acronyms, place your cursor where you want the acronyms list.
5. Click the References tab, and click Insert Index.
6. On the form box, leave the defaults, but ensure the "Columns" option is set to "Auto."
7. Select the entire index Word just inserted.
8. Run the macro.

Need help adding a macro? Reference this site. 

Sub ChangeIndextoAcronymList()

' Converts selected field to static text

    Selection.Fields.Unlink

'Replaces blank Index Heading lines.

  Selection.Find.ClearFormatting
    Selection.Find.Style = ActiveDocument.Styles("Index Heading")
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindFalse
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    
    Selection.Find.Execute Replace:=wdReplaceAll
    
' Finds the left parenthesis and replaces it with a tab.

 Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "("
        .Replacement.Text = "^t"
        .Forward = True
        .Wrap = wdFindFalse
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Application.DisplayAlerts = False
    Selection.Find.Execute Replace:=wdReplaceAll
    

' Finds the right parenthesis and tab in the selection and replaces
' it with one tab.

  Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = ")^t"
        .Replacement.Text = "^t"
        .Forward = True
        .Wrap = wdFindFalse
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

' Finds the right parenthesis and comma in the selection and replaces
' it with one tab.

  Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "),"
        .Replacement.Text = "^t"
        .Forward = True
        .Wrap = wdFindFalse
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll


'Converts the selected text to a table with unset number of rows.

    Selection.ConvertToTable Separator:=wdSeparateByTabs, NumColumns:=3, _
        AutoFitBehavior:=wdAutoFitFixed
        
' Insert a row at the top of the table
   Selection.Tables(1).Select
   Selection.InsertRowsAbove 1

' Add Text to cell 1,1 in table and type text
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    Selection.TypeText Text:="Acronym"
    Selection.MoveRight Unit:=wdCell
    Selection.TypeText Text:="Definition"
    Selection.MoveRight Unit:=wdCell

'Apply Table_1 style to the table

    With Selection.Tables(1)
        .Style = "Table_1"
        .ApplyStyleHeadingRows = True
        .ApplyStyleLastRow = False
        .ApplyStyleFirstColumn = False
        .ApplyStyleLastColumn = False
    End With

'Delete third column of selected table

    Selection.Tables(1).Select
    With Selection
        .Columns(3).Delete
    End With

'Cut and paste second column

    Selection.Tables(1).Select
    
    With Selection
        .Columns(2).Select
        .Cut
        .PasteAndFormat (wdPasteDefault)
    End With

' Sort table by first column

    Selection.Tables(1).Select
    Selection.Sort ExcludeHeader:=True, FieldNumber:="Column 1", SortFieldType _
        :=wdSortFieldAlphanumeric, SortOrder:=wdSortOrderAscending

'Apply Table_Text style to the table and auto fits the table

    Selection.Style = ActiveDocument.Styles("Table_Text")
    Selection.Tables(1).AllowAutoFit = True
    Selection.Tables(1).AutoFitBehavior wdAutoFitContent
    Selection.Tables(1).Cell(1, 1).Range.Select
    Selection.Tables(1).AutoFitBehavior wdAutoFitWindow