Attribute VB_Name = "NewMacros"
Sub tab2table()
Attribute tab2table.VB_ProcData.VB_Invoke_Func = "Normal.NewMacros.tab2table"
'
' tab2table Macro
'
'
    
    ' Loop over headers
    Selection.Find.Execute "--- "
    
    Do Until Selection.Find.Found = False
    
        ' Remove header indicator, change formatting and move to next line
        Selection.TypeBackspace
        Selection.Style = ActiveDocument.Styles("Heading 1")
        Selection.MoveDown Unit:=wdLine, Count:=1
        
        ' Create range object and start it at current position
        Dim rng As Range
        Set rng = Selection.Range
        rng.Start = Selection.Range.Start
        
        ' Extend range to next header or end of document
        Selection.Find.Execute "--- "
        If Selection.Find.Found = True Then
            rng.End = Selection.Range.Start - 2
            rng.Select
        Else
            Selection.EndKey Unit:=wdStory, Extend:=wdExtend
        End If
        
        ' Convert range to table
        Selection.ConvertToTable Separator:=wdSeparateByTabs, NumColumns:=6, _
            NumRows:=1, Format:=wdTableFormatNone, ApplyBorders:=False, ApplyShading _
            :=False, ApplyFont:=False, ApplyColor:=False, ApplyHeadingRows:=True, _
            ApplyLastRow:=False, ApplyFirstColumn:=True, ApplyLastColumn:=False, _
            AutoFit:=True, AutoFitBehavior:=wdAutoFitFixed
        Selection.Tables(1).Style = "Light Shading - Accent 1"
        Selection.Rows(1).Select
        Selection.Rows(1).HeadingFormat = wdToggle
        Selection.Columns(1).PreferredWidth = CentimetersToPoints(3.5)
        Selection.Columns(2).PreferredWidth = CentimetersToPoints(5)
        Selection.Columns(3).PreferredWidth = CentimetersToPoints(2.5)
        Selection.Columns(4).PreferredWidth = CentimetersToPoints(3.5)
        Selection.Columns(5).PreferredWidth = CentimetersToPoints(1.5)
        Selection.Columns(6).PreferredWidth = CentimetersToPoints(3)
        
        ' Restart search at start of document
        Selection.HomeKey Unit:=wdStory
        Selection.Find.Execute "--- "
        
    Loop
    
'    Selection.Find.Execute " ***"
    
'    Do Until Selection.Find.Found = False
'        Selection.TypeText Text:=ChrW(61558)
'        Selection.Find.Execute
'    Loop

End Sub