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
    If InStr(Split(.Cell(1, 1).Range.Text, vbCr)(0), "Total Reward Statement") > 0 Then
      For r = .Rows.Count To 1 Step -1
        If Split(.Cell(r, 1).Range.Text, vbCr)(0) = "Shares Total Reward Statement" Then Exit For
        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
      Next
    End If
  End With
Next
Application.ScreenUpdating = False
End Sub