Sub MailMergeToDoc()
Application.ScreenUpdating = False
Dim t As Long, r As Long, bDel As Boolean
ActiveDocument.MailMerge.Execute
With ActiveDocument
  For t = .Tables.Count To 1 Step -1
    With .Tables(t)
      If Split(.Cell(1, 1).Range.Text, vbCr)(0) Like "#### Awards (Vesting ####)" Then
        bDel = True
        For r = .Rows.Count - 1 To 2 Step -1
          If Trim(Split(.Cell(r, 1).Range.Text, vbCr)(0)) Like "[DPR][BS]P Award" Then
            If Split(.Cell(r, 4).Range.Text, vbCr)(0) <> "" Then
              bDel = False
            Else
              .Rows(r).Delete
            End If
          End If
        Next
      If bDel = True Then .Delete
      End If
    End With
  Next
End With
Application.ScreenUpdating = False
End Sub