Sub TableCleanup()
  Dim aTbl As Table, aCell As Cell, aRng As Range, sEoC As String
  Set aTbl = ActiveDocument.Tables(ActiveDocument.Tables.Count)
  sEoC = Chr(13) & Chr(7)
  TableSearchReplace aTbl, "!!Edit as necessary!!", "", False
  TableSearchReplace aTbl, "^p^w", "^p", False
  TableSearchReplace aTbl, "^w^p", "^p", False
  TableSearchReplace aTbl, "^13{2,}", "^p", True
  TableSearchReplace aTbl, "re re", "re-re", False
  TableSearchReplace aTbl, "preferebly", "preferably", False
  For Each aCell In aTbl.Range.Cells
    Set aRng = aCell.Range
    Do While aRng.Characters.Last.Previous = Chr(13) And Len(aRng.Text) > 2
      aRng.Characters.Last.Previous.Delete
    Loop
    Do While aRng.Characters.First = Chr(13)
      aRng.Characters.First.Delete
    Loop
    If aCell.ColumnIndex = 2 And aCell.RowIndex > 1 Then aCell.Range.Style = "List Bullet"
  Next aCell
End Sub
Function TableSearchReplace(aTbl As Table, sFind As String, sReplace As String, Optional bWC As Boolean = False)
  With aTbl.Range.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = sFind
    .Format = False
    .Replacement.Text = sReplace
    .Forward = True
    .Wrap = wdFindStop
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = bWC
    .Execute Replace:=wdReplaceAll
  End With
End Function