Dear Team,

I had changed the code as per my requirement and now the problem is solved.

The modified code is here

Option ExplicitSub Remindermail()
Dim lRow As Integer
Dim i As Integer
Dim toDate As Date
Dim toList, CCList As String
Dim eSubject As String
Dim eBody As String
Dim OutApp As Object, _
OutMail As Object
Dim Signature As String
Dim sPath As String
Dim S As String


With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .DisplayAlerts = False
End With


Sheets("Data").Select
lRow = Cells(Rows.Count, 4).End(xlUp).Row


Set OutApp = CreateObject("Outlook.Application")


S = Environ("appdata") & "\Microsoft\Signatures\"
If Dir(S, vbDirectory) <> vbNullString Then S = S & Dir$(S & "*.htm") Else S = ""
S = CreateObject("Scripting.FileSystemObject").GetFile(S).OpenAsTextStream(1, -2).ReadAll


For i = 4 To lRow
  If Cells(i, 9).Value >= 1 And Cells(i, 9).Value <= 10 And Cells(i, 10).Value = "" Then
     Set OutMail = OutApp.CreateItem(0)
        toList = Cells(i, 4)    'gets the recipient from col B
        'CCList = Cells(i, 8) & ", " & Cells(i, 9) & ", " & Cells(i, 10)
        eSubject = "Calibration remainder for your " & Cells(i, 5) & " Batching Plant "
        eBody = "<font style=""font-family:Cambria; font-size:12pt;""/font> Dear Sir, <br><br>" _
        & "Greetings from " & "<b> SCHWING STETTER! </b><br><br>" _
        & "Your " & "<b>" & Worksheets("Data").Cells(i, "E").Value & "</b>" _
        & " Batching Plant calibration certificate is going to expire soon ( within " _
        & "<b>" & Worksheets("Data").Cells(i, "I").Value & "</b>" & " days ).<br><br>" _
        & "Plant Last calibration done date is " & "<b>" & Worksheets("Data").Cells(i, "G").Value & "</b>" _
        & " and next due date is " & "<b>" & Worksheets("Data").Cells(i, "H").Value & "</b>" & ".<br><br>" _
        & "Kindly do the calibration on time for accurate batching.<br><br>" & S


        
        On Error Resume Next
        With OutMail
        .To = toList
        .CC = CCList
        .BCC = ""
        .Subject = eSubject
        .HTMLBody = eBody
        .Display   ' ********* Creates draft emails. Comment this out when you are ready
        '.Send     '********** UN-comment this when you  are ready to go live
        End With
 
    On Error GoTo 0
    Set OutMail = Nothing
 Cells(i, 10) = "Reminder Sent on " & Date  'Marks the row as "email sent in Column A"
End If
Next i


Set OutApp = Nothing


ActiveWorkbook.Save


With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .DisplayAlerts = True
End With
Sheets("Data").Range("A1").Select
End Sub