Create a diary entry from populating a line in a tracker spreadsheet

[Draks]

Afternoon all,

Firstly I'm not even sure if this can be done, so I guess that is the first hurdle.
Secondly, If it can can I have some help with even starting the coding/recording a macro as I can't even think how to start this.
what I'm trying to do:
Using the below table when I enter a new line in the tracker send a diary entry to the person Column C (Sarah) for the date in Column M (03/05/23) with the subject: "Quote Follow Up: Column D,E,F. (Testing a Macro choose me)

Date of Quote

Quote Revision

Who's Account

Client Name

Project Name

Project Location

Number Of Plots

Net Value

Gross Value

Main Product

Standard Stock

Painted

Follow Up Date

Status of Quote

Outcome Of Follow Up / Action Needed

Date Of Next Chase

Origin of lead

Additional Notes

19/04/2023​

1

Sarah

Testing

a macro

choose me

1​

£ 500.00

£ 600.00

Aluminium

Yes

No

03/05/2023​

Requires Follow Up

all contacts are internal and have access to the spreadsheet/quotes so don't need to include any links to these.

I currently have a separate tab with Picklists which is where the email addresses are.

I hope that makes sense?

TIA for any help. even if it is just "this can't be done"

Sarah

 

[Logit]

Do you have an duplicate employee names ? i.e., two different 'Sarahs' ?

Does everyone have their own, unique email address ?

 

[Draks]

Do you have an duplicate employee names ? i.e., two different 'Sarahs' ?

Does everyone have their own, unique email address ?

Hi, no all unique names and email addresses.

 

[Draks]

Hi,

So I have had a bit of a play and updated my spreadsheet as I have been trying to play around with codes. I sort of had it working then I changed something in the code and now it doesn't work at all and I don't know what I broke. Sorry if this isn't making sense. As an aside the emails are unique and populated by a formula as is the follow up date column.

This is my spreadsheet:

Date of Quote

Quote Revision

Who's Account

Email Address

Client Name

Project Name

Project Location

Number Of Plots

Net Value

Gross Value

Main Door Type

Standard Stock

Painted

Hanging Rail

Accessories/Lights

Follow Up Date

Status of Quote

Outcome Of Follow Up / Action Needed

Date Of Next Chase

Origin of lead

Date of Designs

Additional Notes

1​

Sarah

Sarah@draks.co.uk

This is to test

the code for

calendar & email

1​

100​

120​

test

yes

no

chrome

tbc

What I would like to happen is when Date of Quote is populated & Status Of quote is changed to "Requires Follow Up" an email and/or a diary entry is sent to the Account holder (Email Address column) that has the following information

	EMAIL:	DIARY ENTRY:
Subject:	Quote Follow Up Reminder	Client, Project, Quote Follow up
Body:	Hi Column 3 I have completed the following quote and it is ready for sending: Client: This is to test Project: the code for Location: Calendar & Email Quote Revision: 1 Please check that you have a reminder for follow up in 14 days on your diary. Thanks Sarah	Follow up due: Client: This is to test Project: the code for Location: Calendar & Email Quote Revision: 1 Please update the Sales Tracker with outcome of Follow up.
Start & End Dates:		Start: Date Of Quote End: Follow Up Date

Code which now doesn't work is:

Dim xRg As Range

Private Sub Worksheet_Change(ByVal Target As Range)

On Error Resume Next

If Target.Cells.Count > 1 Then Exit Sub

Set xRg = Intersect(Range("P5:P20"), Target)

If xRg Is Nothing Then Exit Sub

If Target.Value > 0 Then

Call Mail_small_Text_Outlook(Target.Row)

End If

End Sub



Sub Mail_small_Text_Outlook(ByVal TargetRow As Long)

Dim xOutApp As Object

Dim xOutMail As Object

Dim xMailBody As String

Dim wsActiveSheet As Worksheet





Set xOutApp = CreateObject("Outlook.Application")

Set xOutMail = xOutApp.CreateItem(0)

Set wsActiveSheet = Application.ActiveSheet



xMailBody = "This quote requires following up, Please check the calendar entry has populated for 14 days' time." & vbNewLine & vbNewLine & _

"Client: " & CStr(wsActiveSheet.Cells(TargetRow, 5).Text) & vbNewLine & _

"Name of Project: " & CStr(wsActiveSheet.Cells(TargetRow, 6).Text) & vbNewLine & vbNewLine & _

"Location: " & CStr(wsActiveSheet.Cells(TargetRow, 7).Text) & vbNewLine & _

"Thank you"



On Error Resume Next

With xOutMail

.To = CStr(wsActiveSheet.Cells(TargetRow, 4).Text)

.CC = ""

.BCC = ""

.Subject = "Quote Follow Up reminder"

.Body = xMailBody

.Display 'or use .Send

End With

On Error GoTo 0

Set xOutMail = Nothing

Set xOutApp = Nothing





Set olOutlook = CreateObject("Outlook.Application")

Set Namespace = olOutlook.GetNamespace("MAPI")

Set oloFolder = Namespace.GetDefaultFolder(9)



LastRow = Cells(Rows.Count, 2).End(xlUp).Row



For I = 5 To LastRow



Description = CStr(wsActiveSheet.Cells(1, 2).Text)

StartDate = Cells(P, 2).Value

EndDate = Cells(P, 3).Value



Set Appointment = Calendar.items.Add



With Appointment

.Start = StartDate

.End = EndDate

.Subject = Description

.Save



End With



Next I

End Sub

 

[Logit]

Option Explicit

Sub Send_Email()

    Dim c As Range
    Dim strBody As String
    Dim OutLookApp As Object
    Dim OutLookMailItem As Object
    Dim i As Integer
    On Error Resume Next
    
    
    For Each c In Range("D2:D1000")
    strBody = "Hi " & c.Offset(0, -1).Value & " I have completed the following quote and it is ready for sending:" & "<br></br><br></br>" _
                & "CLIENT : " & c.Offset(0, 1).Value & "<br></br><br></br>" _
                & "PROJECT : " & c.Offset(0, 2).Value & "<br></br><br></br>" _
                & "LOCATION : " & c.Offset(0, 3).Value & "<br></br><br></br><br></br>" _
                & "Please check that you have a reminder for follow up in 14 days on your diary." & "<br></br><br></br>" _
                & "Thanks" & "<br></br>" _
                & "Sarah"
                
        If c.Value <> "" Then
            Set OutLookApp = CreateObject("Outlook.application")
            Set OutLookMailItem = OutLookApp.CreateItem(0)
            With OutLookMailItem
                    .To = c.Value
                    .CC = ""
                    .Subject = "Quote Follow Up Reminder"
                    .HTMLBody = strBody
                    '.Attachments.Add
                    .Display
                    '.Send
            End With
        End If
    Next c

End Sub

 

[Draks]

Option Explicit

Sub Send_Email()

    Dim c As Range
    Dim strBody As String
    Dim OutLookApp As Object
    Dim OutLookMailItem As Object
    Dim i As Integer
    On Error Resume Next
   
   
    For Each c In Range("D2:D1000")
    strBody = "Hi " & c.Offset(0, -1).Value & " I have completed the following quote and it is ready for sending:" & "<br></br><br></br>" _
                & "CLIENT : " & c.Offset(0, 1).Value & "<br></br><br></br>" _
                & "PROJECT : " & c.Offset(0, 2).Value & "<br></br><br></br>" _
                & "LOCATION : " & c.Offset(0, 3).Value & "<br></br><br></br><br></br>" _
                & "Please check that you have a reminder for follow up in 14 days on your diary." & "<br></br><br></br>" _
                & "Thanks" & "<br></br>" _
                & "Sarah"
               
        If c.Value <> "" Then
            Set OutLookApp = CreateObject("Outlook.application")
            Set OutLookMailItem = OutLookApp.CreateItem(0)
            With OutLookMailItem
                    .To = c.Value
                    .CC = ""
                    .Subject = "Quote Follow Up Reminder"
                    .HTMLBody = strBody
                    '.Attachments.Add
                    .Display
                    '.Send
            End With
        End If
    Next c

End Sub

Thank you so much Logit, that works beautifully to create the email.
I am possibly pushing my luck here but wondered if you can help as if I put in my "Worksheet change" code it is throwing an error. and I am going code blind trying to read the help pages and work out where I have gone wrong. (this is my first step back into code in about 5 years and I wasn't great at it then, hence my ignorance/stupidity)
If I put in as I did earlier (see below) then it throws: Compile Error: Sub or Function not defined and
If I change the `call line` to: "Call Send_Email(Target.Row)" Then I get: Compile Error: Wrong number of arguments or Invalid property assignment.

Code Typed:
Dim xRg As Range

Private Sub Worksheet_Change(ByVal Target As Range)

On Error Resume Next

If Target.Cells.Count > 1 Then Exit Sub

Set xRg = Intersect(Range("P5:P20"), Target)

If xRg Is Nothing Then Exit Sub

If Target.Value > 0 Then

Call Mail_small_Text_Outlook(Target.Row)

End If

End Sub

Any Help would be much appreciated even if it is just; this can only be run manually. Thank you

 

[Logit]

The following works here. Note that my macro calls "Send_Email" as the name of the emailing macro.

Option Explicit

Dim xRg As Range

Private Sub Worksheet_Change(ByVal Target As Range)

On Error Resume Next

    If Target.Cells.Count > 1 Then Exit Sub
    
        Set xRg = Intersect(Range("P5:P20"), Target)
        
            If xRg Is Nothing Then Exit Sub
        
            If Target.Value > 0 Then
        
                Send_Email
    
            End If

End Sub