Public Sub RunMacroMarkSent()
Dim Target As Range
Application.DisplayAlerts = True

Dim xOutApp As Object
Dim xMailItem As Object
Dim cell As Range
Dim xMailBody As String
Dim KeyColumn As String
Dim CheckValue As String

'On Error Resume Next
'Application.ScreenUpdating = False
'Application.DisplayAlerts = False
' Set the target column (column J = column 10)

'If Target.Column = 10 Then

' find the used range
lastrow = Cells(Rows.Count, 1).End(xlUp).Row

' check the date column
For Each cell In Range("J2:J" & lastrow)

'if already sent email, skip
If Range("K" & cell.Row).Value = cell.Value Then GoTo nextrow

If cell.Value = "Expiration" Or cell.Value = "Reminder" Then

'copy value to next cell so you know email sent
Range("K" & cell.Row).Value = cell.Value

Set xOutApp = CreateObject("Outlook.Application")

Set xMailItem = xOutApp.CreateItem(0)
xMailBody = "Reminder:" & vbNewLine & _
"Worksheet:" & Me.Name & vbNewLine & _
"Location: " & Range("C" & cell.Row).Value & vbNewLine & _
"Content: " & cell.Value & vbNewLine & _
"Time:" & Format(Now, "yyyy-mm-dd hh:mm:ss") & vbNewLine

With xMailItem
.To = "xxxx@xxxx.xxx"
.Subject = "?Excel Reminder?Task due reminder!"
.Body = xMailBody
.Display 'Change to .Send to send automatically
.Save
End With

Set xMailItem = Nothing
Set xOutApp = Nothing

nextrow:
End If
Next cell


'Application.DisplayAlerts = True
'Application.ScreenUpdating = True
End Sub