Sub TextToComments()
Dim oDoc As Document
Dim oRng As Range
Dim MyString As String
'Dim myUsername As String
'Dim myUserinitials As String
Dim oComment As Comment

    'myUsername = Application.UserName
    'myUserinitials = Application.UserInitials
    'Application.UserName = "JSmith"
    'Application.UserInitials = "JS"
    Application.ScreenUpdating = False
    Set oDoc = ActiveDocument
    oDoc.TrackRevisions = False
    Set oRng = oDoc.Range
    oRng.Paragraphs.LineSpacingRule = wdLineSpaceSingle
    With oRng.ParagraphFormat
        .SpaceBefore = 0
        .SpaceBeforeAuto = False
        .SpaceAfter = 6
        .SpaceAfterAuto = False
        .LineSpacingRule = wdLineSpaceSingle
    End With
    With oRng.Find
        With .Font
            .Bold = True
        End With
        Do While .Execute(FindText:="(\[*\])", MatchWildcards:=True, _
                Format:=True)
            MyString = oRng.Text
            MyString = Mid(MyString, 2, Len(MyString) - 2)
            If Not Left(MyString, 3) = "TS:" Then
                'MyString = Mid(MyString, InStr(1, MyString, ":") + 2)
                oRng.Text = MyString
                oRng.Delete
                Set oComment = oDoc.Comments.Add(oRng, MyString)
                oComment.Author = "MNathan"
                'If Val(Application.Version) > 14 Then
                '    oComment.Author = Application.UserName
                'End If
                oRng.Font.Bold = False
            End If
            oRng.Collapse 0
        Loop
    End With
    oRng.Collapse 1
    oRng.Select
    Application.ScreenUpdating = True
    'Application.UserName = myUsername
    'Application.UserInitials = myUserinitials
lbl_Exit:
    Set oDoc = Nothing
    Set oRng = Nothing
    Set oComment = Nothing
    Exit Sub
End Sub