Struggling with VBA Script

Newbie_Nat

New Member
Joined
Jan 8, 2021
Messages
6
Office Version
  1. 365
Platform
  1. Windows
Hello
I am very new to using VBA scripts! Customer has asked for an automated email using data from a worksheet. This is for holiday requests, so the row will change when a new request is submitted. I have managed to get the following to work to some extent, but not all info is being pulled successfully to the email:

VBA Code:
Dim xRg As Range
'Update by Extendoffice 2018/3/7
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Target.Cells.Count > 1 Then Exit Sub
  Set xRg = Intersect(Range("M5:M20"), Target)
    If xRg Is Nothing Then Exit Sub
    If Target.Value > 0 Then
        Call Mail_small_Text_Outlook
    End If
End Sub
Sub Mail_small_Text_Outlook()
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xMailBody As String
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    xMailBody = "Please accept this email as confirmation of your holiday booking - information as below" & vbNewLine & vbNewLine & _
    "Date of Request: " & Str(Sheet1.Cells(5, 6)) & vbNewLine & _
    "Number of Days Booked:" & Str(Sheet1.Cells(5, 5)) & vbNewLine & vbNewLine & _
              "2021 Leave Remaining as at today's date:" & Str(Sheet1.Cells(5, 8)) & " days" & vbNewLine & _
              "Data Entered By:" & vbNewLine & vbNewLine & _
              "Authorised By:" & Str(Sheet1.Cells(5, 7)) & vbNewLine & vbNewLine & _
              "Thank you"
    On Error Resume Next
    With xOutMail
        .To = "****@******.com"
        .CC = ""
        .BCC = ""
        .Subject = "Holiday Booking Confirmation"
        .Body = xMailBody
        .Display   'or use .Send
    End With
    On Error GoTo 0
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub

Authorised by is entered in the spreadhseet as NP 06/01/2021 - this is being pulled as 0 in the email. I've tried different types of cell formatting but to no avail.
Data Entered by - this is initials only and is the trigger cell for the email. Nothing is being pulled to the email at all.

I hope I've given enough information for someone to help!?

Many thanks in advance :)
 

Some videos you may like

Excel Facts

How to change case of text in Excel?
Use =UPPER() for upper case, =LOWER() for lower case, and =PROPER() for proper case. PROPER won't capitalize second c in Mccartney

dmt32

Well-known Member
Joined
Jul 3, 2012
Messages
6,477
Office Version
  1. 2019
Platform
  1. Windows
Hi
try this update to the xmailbody part of your code

Rich (BB code):
xMailBody = "Please accept this email As confirmation of your holiday booking - information As below" & vbNewLine & vbNewLine & _
                "Date of Request: " & CStr(Sheet1.Cells(5, 6).Text) & vbNewLine & _
                "Number of Days Booked:" & CStr(Sheet1.Cells(5, 5).Text) & vbNewLine & vbNewLine & _
                "2021 Leave Remaining As at  today 's date:" & CStr(Sheet1.Cells(5, 8).Text) & " days" & vbNewLine & _
                "Data Entered By:" & CStr(Sheet1.Cells(5, 7).Text) & vbNewLine & vbNewLine & _
                "Authorised By:" & CStr(Sheet1.Cells(5, 7).Text) & vbNewLine & vbNewLine & _
                "Thank you"

You had no cell reference for Data Entered By - change range shown in BOLD as required

Hope Helpful

Dave
 

Newbie_Nat

New Member
Joined
Jan 8, 2021
Messages
6
Office Version
  1. 365
Platform
  1. Windows
Dave - thanks very much, that worked perfectly! :)

I suppose my next question is how do I get the script to automatically go to the next row when another holiday request is entered? Rather than have to manually change the script? There are 34 employees, so really want to avoid have to change the script manually!

Hope that makes sense?

Many thanks,
Nat
 

dmt32

Well-known Member
Joined
Jul 3, 2012
Messages
6,477
Office Version
  1. 2019
Platform
  1. Windows
Dave - thanks very much, that worked perfectly! :)

I suppose my next question is how do I get the script to automatically go to the next row when another holiday request is entered? Rather than have to manually change the script? There are 34 employees, so really want to avoid have to change the script manually!

Hope that makes sense?

Many thanks,
Nat

Pleased update helped.
Probably different question but one idea would be to pass the row number as an argument from the calling procedure

Rich (BB code):
'Updated 2021/1/8
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Target.Cells.Count > 1 Then Exit Sub
  Set xRg = Intersect(Range("M5:M20"), 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
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
  
    xMailBody = "Please accept this email As confirmation of your holiday booking - information As below" & vbNewLine & vbNewLine & _
                "Date of Request: " & CStr(Sheet1.Cells(TargetRow, 6).Text) & vbNewLine & _
                "Number of Days Booked:" & CStr(Sheet1.Cells(TargetRow, 5).Text) & vbNewLine & vbNewLine & _
                "2021 Leave Remaining As at today's date:" & CStr(Sheet1.Cells(TargetRow, 8).Text) & " days" & vbNewLine & _
                "Data Entered By:" & CStr(Sheet1.Cells(TargetRow, 7).Text) & vbNewLine & vbNewLine & _
                "Authorised By:" & CStr(Sheet1.Cells(TargetRow, 7).Text) & vbNewLine & vbNewLine & _
                "Thank you"
  
    On Error Resume Next
    With xOutMail
        .To = "****@******.com"
        .CC = ""
        .BCC = ""
        .Subject = "Holiday Booking Confirmation"
        .Body = xMailBody
        .Display   'or use .Send
    End With
    On Error GoTo 0
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub

see if this does what you want - don't forget tp update range shown in bold to correct cell address

Dave
 

Newbie_Nat

New Member
Joined
Jan 8, 2021
Messages
6
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

@dmt32 - Again, worked perfectly, thank you so much! :)
Just need to create 34 of them now!
 

Newbie_Nat

New Member
Joined
Jan 8, 2021
Messages
6
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

There are 34 employees each with their own worksheet - so I'll copy & paste and change the sheet number........
 

dmt32

Well-known Member
Joined
Jul 3, 2012
Messages
6,477
Office Version
  1. 2019
Platform
  1. Windows
There are 34 employees each with their own worksheet - so I'll copy & paste and change the sheet number........
Helpful if you had stated that

- you just update to make it a common code


Place in a standard Module

VBA Code:
Sub Mail_small_Text_Outlook(ByVal Target As Range)
    Dim xOutApp As Object, xOutMail As Object
    Dim xMailBody As String
    Dim ws As Worksheet
    
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    Set ws = Target.Parent
    
    xMailBody = "Please accept this email As confirmation of your holiday booking - information As below" & vbNewLine & vbNewLine & _
                "Date of Request: " & CStr(ws.Cells(Target.Row, 6).Text) & vbNewLine & _
                "Number of Days Booked:" & CStr(ws.Cells(Target.Row, 5).Text) & vbNewLine & vbNewLine & _
                "2021 Leave Remaining As at today's date:" & CStr(ws.Cells(Target.Row, 8).Text) & " days" & vbNewLine & _
                "Data Entered By:" & CStr(ws.Cells(Target.Row, 7).Text) & vbNewLine & vbNewLine & _
                "Authorised By:" & CStr(ws.Cells(Target.Row, 7).Text) & vbNewLine & vbNewLine & _
                "Thank you"
   
    On Error Resume Next
    With xOutMail
        .To = "****@******.com"
        .CC = ""
        .BCC = ""
        .Subject = "Holiday Booking Confirmation"
        .Body = xMailBody
        .Display   'or use .Send
    End With
    On Error GoTo 0
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub

If you are using Worksheet_Change event in each sheet to call the code??

Then delete them & place following in the Thisworkbook Code Page

VBA Code:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    If Target.Cells.Count > 1 Then Exit Sub
    If Not Intersect(Range("M5:M20"), Target) Is Nothing Then
        If Len(Target.Value) > 0 Then Call Mail_small_Text_Outlook(Target)
    End If
End Sub

This code will trigger for all worksheets in your workbook - if there are sheets you need to exclude let me know & will update code

Dave
 

Newbie_Nat

New Member
Joined
Jan 8, 2021
Messages
6
Office Version
  1. 365
Platform
  1. Windows
@dmt32 - Apologies! Thanks, I'll add that. No sheets to exclude, so all good.

The other thing I was going to ask - is there a way to add the holiday detail to an O365 calendar, both individual and a shared?

Thanks again :)
 

dmt32

Well-known Member
Joined
Jul 3, 2012
Messages
6,477
Office Version
  1. 2019
Platform
  1. Windows
@dmt32 - Apologies! Thanks, I'll add that. No sheets to exclude, so all good.

The other thing I was going to ask - is there a way to add the holiday detail to an O365 calendar, both individual and a shared?

Thanks again :)
Probably but is a new question - suggest start another thread

Good luck with project

Dave
 

Watch MrExcel Video

Forum statistics

Threads
1,127,098
Messages
5,622,683
Members
415,920
Latest member
ExcelNoob28

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
Top