VBA Expert please help!

Mindy2017

New Member
Joined
Aug 7, 2018
Messages
7
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):confused:
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
 

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
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
 
Upvote 0
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....
 
Upvote 0

Forum statistics

Threads
1,223,227
Messages
6,170,849
Members
452,361
Latest member
d3ad3y3

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top