Dim aRng As Range, sText As String
 Dim aTbl As Table, aRow As Integer, aCell As Cell
 Dim fCount As Integer
        
    
       
    Set aTbl = ActiveDocument.Tables(1)
    Set aRng = aTbl.Range
    
    For aRow = 1 To aTbl.Rows.Count
      Set aRng = aTbl.Cell(iRow, 3).Range
      
      With aRng.Find
        .Text = "\[*\]"
        .MatchWildcards = True
        .Replacement.Highlight = True
        .Execute Replace:=wdReplaceAll
     End With
    
      Selection.Find.Font.Bold = True
      With aRng.Find
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchSoundLike = False
        .MatchAllWordForms = False
        .MatchWildcards = False
        .Replacement.Highlight = True
        .Execute Replace:=wdReplaceAll
     End With
        
    
    Next aRow