VBA to Send Email with Outlook

Here what could be done

Option Explicit

Sub Treat()
Const DataWsN = "Data"
Const OrgMsg = " Please check die for completion ETA"
Const RedMsg = " is due Today/Past Due, please follow asap"
Const MsgSt = "Die "

Dim WkRg  As Range, WkRg1 As Range, Rg As Range
Dim LR As Integer

Dim EmailSubject  As String
Dim EmailStart1 As String
Dim EmailBody  As Range
Dim EmailEnd1 As String, EmailEnd2 As String
Dim Email_List As Range
Dim DestEmail As String
Dim EmailList As Range

Dim myOlApp As Outlook.Application
Dim myItem As Outlook.MailItem
    Set myOlApp = CreateObject("Outlook.Application")
    Set myItem = myOlApp.CreateItem(olMailItem)
    
Dim DataWs As Worksheet
    Set DataWs = Sheets(DataWsN)
    
'---  People Email list preparation
    Set EmailList = Range("EmailList")
    If EmailList.Rows.Count = 0 Then MsgBox (" No email to send information "): Exit Sub
    DestEmail = ""
    For Each Rg In EmailList
        If (Len(Rg) <> 0) Then DestEmail = DestEmail & "," & Rg
    Next Rg
    DestEmail = Mid(DestEmail, 2)

'---  Email info
    EmailSubject = Range("EmailSubject")
    EmailStart1 = Range("EmailStart1")
    EmailEnd1 = Range("EmailEnd1")
    EmailEnd2 = Range("EmailEnd2")
    
    With DataWs
        Set EmailBody = Range("EmailBody")
        EmailBody.ClearContents
'       Review  Dies list
        Set WkRg = .UsedRange
        If (.AutoFilterMode) Then ActiveSheet.AutoFilterMode = False '  REMOVE  AUTOFILTER  IF  EXIST
        
'       RED  Dies
        WkRg.AutoFilter Field:=8, Criteria1:=RGB(255, 0, 0), Operator:=xlFilterCellColor
        LR = .Cells(Rows.Count, 1).End(3).Row
        If (LR > 1) Then
            Set WkRg1 = Range(.Cells(2, 1), .Cells(LR, 1))
            For Each Rg In WkRg1.SpecialCells(xlCellTypeVisible)
                EmailBody = EmailBody & vbCrLf & _
                    MsgSt & Rg & RedMsg
            Next Rg
            EmailBody = Mid(EmailBody, 2)
        End If
        
'       ORANGE  Dies
        WkRg.AutoFilter Field:=8, Criteria1:=RGB(255, 192, 0), Operator:=xlFilterCellColor
        LR = .Cells(Rows.Count, 1).End(3).Row
        If (LR > 1) Then
            Set WkRg1 = Range(.Cells(2, 1), .Cells(LR, 1))
            For Each Rg In WkRg1.SpecialCells(xlCellTypeVisible)
                EmailBody = EmailBody & vbCrLf & _
                    MsgSt & Rg & OrgMsg
            Next Rg
        End If
    End With

    EmailBody = EmailStart1 & _
                EmailBody & vbCrLf & _
                EmailEnd1 & vbCrLf & _
                EmailEnd2 & vbCrLf
                
'---  Send Email
    Application.DisplayAlerts = False
    With myItem
        .To = DestEmail
        .Subject = EmailSubject
        .Body = EmailBody
        .Send
    End With
    Application.DisplayAlerts = True
    
'---  Close
    Set myItem = Nothing
    Set myOlApp = Nothing
    MsgBox ("  Email sent")
   
End Sub