Sub Update_Calender(FormulaCell As Range)
Dim objOL As Object
Dim objItem As Object
Dim lngRow As Long
Set objOL = CreateObject("Outlook.Application")
lngRow = 4
Dim oSheet As Worksheet
Set oSheet = ThisWorkbook.Worksheets("Sheet1") ' Change "Sheet1" to actual sheet name
If oSheet.Cells(lngRow, 2).Text <> "" Then
Set objItem = objOL.createitem(1) ' constant olAppointmentItem = 1
With objItem
.Body = oSheet.Cells(FormulaCell.Row, "B").Value & vbNewLine & vbNewLine & _
"Your task is due : " & oSheet.Cells(FormulaCell.Row, "A").Value & _
vbNewLine & vbNewLine & "Please update your task"
.Duration = 60
.Start = oSheet.Cells(FormulaCell.Row, "D").Value & " 9:00:00 AM"
.Subject = oSheet.Range("B4").Value
.ReminderMinutesBeforeStart = "30"
.Save
End With
End If
lngRow = lngRow + 1
Set objItem = Nothing
Set objOL = Nothing
MsgBox "Your due date for this task has been added to your calender"
End Sub