Sub MailMergeToDoc()
Application.ScreenUpdating = False
Dim Tbl As Table, r As Long, c As Long
ActiveDocument.MailMerge.Execute
For Each Tbl In ActiveDocument.Tables
  With Tbl
    With .Range
      With .Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = "[DPR][BS]P Award"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchWildcards = True
        .Execute
      End With
      Do While .Find.Found
        If .InRange(Tbl.Range) = False Then Exit Do
        If .Cells(1).ColumnIndex = 1 Then
          r = .Cells(1).RowIndex
          With Tbl
            Select Case Trim(Split(.Cell(r, 1).Range.Text, vbCr)(0))
              Case "PSP Award", "DBP Award", "RSP Award"
              If Split(.Cell(r, 4).Range.Text, vbCr)(0) = "" Then
                For c = 4 To 1 Step -1
                  .Cell(r, c).Delete
                Next
              End If
            End Select
          End With
        End If
        .Collapse wdCollapseEnd
        .Find.Execute
      Loop
    End With
  End With
Next
Application.ScreenUpdating = False
End Sub