VBA Expert please help!

[Mindy2017]

Can some please help....I am working on a short deadline.


My table:

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]A gentle Reminder:[/TD]
[TD]Your trip is scheduled in two weeks[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]Destination[/TD]
[TD]Date[/TD]
[TD]Days[/TD]
[TD]Reminder[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]Boston[/TD]
[TD]8/18/2018[/TD]
[TD]10[/TD]
[TD]Send Reminder[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]New York[/TD]
[TD]8/18/2018[/TD]
[TD]10[/TD]
[TD]Send Reminder[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]South Africa[/TD]
[TD]9/20/2018[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]


My code to do what I need this table to do:

Sub datesexcelvba()
Dim OutLookApp As Object
Dim OutLookMailItem As Object
Dim icounter As Integer
Dim maildest As String
Dim mydate1 As Date
Dim mydate2 As Long
Dim datetoday1 As Date
Dim datetoday2 As Long
Dim cell As Range
Dim Subj As String
Dim Msg As String

This part of the table is causing an error message to come up (HOWEVER ITS THE MOST IMPORTANT PART)
LR = Range("D" & Rows.Count).End(x1UP).Row
For Each cell In Range("D3:D" & LR)
If Reminder(cell) = "Send Reminder" Then
Pos = WorksheetFunction.Find("", cell.Offset(, -1))
FName = Left(cell.Offset(, -1), Pos - 1)
Subject = "Friendly Reminder that this"
Msg = "This Property " & FName & "," & vbNewLine
Msg = Msg & vbNewLine & " is schedule to begin Rapid Rehab in two weeks. Have a wonderful day." & vbCrLf & vbCrLf

Dim x As Long
lastrow = Sheets("Ok-Green").Cells(Rows.Count, 1).End(xlUp).Row
For x = 3 To lastrow
mydate1 = Cells(x, 2).Value
mydate2 = mydate1
Cells(x, 6).Value = mydate2
datetoday1 = Date
datetoday2 = datetoday1
Cells(x, 7).Value = datetoday2
If mydate2 - datetoday2 = 10 Then
Set OutLookApp = CreateObject("Outlook.application")
Set OutLookMailItem = OutLookApp.createitem(OlMailItem)
Cells(x, 4) = "Send Reminder"
Cells(x, 3).Interior.ColorIndex = 3
Cells(x, 3).Font.ColorIndex = 2
Cells(x, 3).Font.Bold = True
Cells(x, 3).Value = mydate2 - datetoday2
End If
Next
Set myApp = Nothing
Set mymail = Nothing
Set OutLookApp = CreateObject("Outlook.application")
Set OutLookMailItem = OutLookApp.createitem(OlMailItem)
MailDest1 = "mindy2017art@gmail.com"
MailDest2 = "mindy2017art@gmail.com"
With OutLookMailItem
.to = MailDest1
.bcc = MailDest2
.Subject = Range("a1").Value
.Body = Range("B1").Value
'.send
.display
End With
Set OutLookMailItem = Nothing
Set OutLookApp = Nothing
End Sub

 

[JoeMo]

Have only glanced at your code and no idea what you want it to do, but this line caught my eye:

LR = Range("D" & Rows.Count).End(x1UP).Row

The character in blue font looks like the numeral 1, but it should be a lower case L (l). The corrected line would be:

LR = Range("D" & Rows.Count).End(xlUP).Row

 

[Mindy2017]

Joe, all I am trying to do is get my Subject line to Read: A gentle reminder that your trip to (LOCATION)....

Location is based on the rows in Col D that has the reminder message "Send Reminder"

for example:

Column A contain the locations

Column D contain the reminder notice

Working code: Your trip to Boston and New York is....