# Worksheet_Change Event Sends Email

I have functioning code that I wrote what seems like a long time ago in a Worksheet_Change event, and even though this works I'm sure that it can be written better. I'm thinking passing the items like CustName = Split(cell.Offset(0,-1).Value, "-")(0) to a variable in a Sub or Function for generating the Email, might be better and easier to maintain, but for the life of me I cannot wrap my head around how to accomplish this. I am open to all thoughts and suggestions y'all have.

Private Sub Worksheet_Change(ByVal Target As Range)

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim pEmail As String
pEmail = "ZackE@VBAisfun.codingrules"

Dim Recipient As String
Recipient = "Zack"

Dim EmailAddr As String
EmailAddr = pEmail

Dim RgCell As Range
Set RgCell = Range("C3:C100")

Dim RgSel As Range
Set RgSel = Intersect(Target, RgCell)

Dim cell As Range

Dim CustName As String, TitleCo As String, ClsDate As String, ContractPrice As String
Dim lamount As String, Product As String, Msg As String, Notes As String

If Not RgSel Is Nothing Then
Dim OutlookApp As Object
Set OutlookApp = CreateObject("Outlook.Application")
Dim MItem As Object
Set MItem = OutlookApp.CreateItem(0)
For Each cell In RgSel
If LCase(cell.Value) = "zack" Then
CustName = Split(cell.Offset(0, -1).Value, "-")(0)
lamount = Format(cell.Offset(0, 14).Value, "Currency")
ClsDate = cell.Offset(0, 8).Value
ContractPrice = Format(cell.Offset(0, 13).Value, "Currency")
Product = cell.Offset(0, 15).Value
TitleCo = cell.Offset(0, 2).Value
Notes = cell.Offset(0, 17).Value

Dim Subj As String
Subj = "***NEW LOAN ASSIGNED***" & " - " & UCase(CustName)

Dim strBeforeRows As String
strBeforeRows = "<head><style>table, th, td {border: 1px solid gray; border-collapse:" & "collapse;}</style></head><body>" & _
"<p>" & "Hello " & Recipient & "," & "<br><br>" & vbNewLine & vbNewLine & _
"You have been assigned the following loan for " & CustName & "." & "</p>" & vbNewLine & _
"<table style=""width:100%""><tr>" & _
"<th bgcolor=""#bdf0ff"">Product</th>" & _
"<th bgcolor=""#bdf0ff"">Loan Amount</th>" & _
"<th bgcolor=""#bdf0ff"">Closing Date</th>" & _
"<th bgcolor=""#bdf0ff"">Title Company</th>" & _
"<th bgcolor=""#bdf0ff"">Notes</th>" & _
"<th bgcolor=""#bdf0ff"">Contract Price</th></tr>"

Dim strRows As String
strRows = strRows & "<tr>"
strRows = strRows & "<td ""col width=10%"">" & Product & "</td>"
strRows = strRows & "<td ""col width=10%"">" & lamount & "</td>"
strRows = strRows & "<td ""col width=10%"">" & ClsDate & "</td>"
strRows = strRows & "<td ""col width=10%"">" & TitleCo & "</td>"
strRows = strRows & "<td ""col width=10%"">" & Notes & "</td>"
strRows = strRows & "<td ""col width=10%"">" & ContractPrice & "</td>"
strRows = strRows & "</tr>"

Dim strAfterRows As String
strAfterRows = "</table></body>"

Dim strAll As String
strAll = strBeforeRows & strRows & strAfterRows

With MItem
.Display
.To = EmailAddr
.Subject = Subj
.HTMLBody = strAll & "<br>" & .HTMLBody
.Send
End With

End If
Next cell

End If
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub


## 2 Answers

Compact html is very hard to read and edit.

                 strBeforeRows = "<head><style>table, th, td {border: 1px solid gray; border-collapse:" & "collapse;}</style></head><body>" & _
"<p>" & "Hello " & Recipient & "," & "<br><br>" & vbNewLine & vbNewLine & _
"You have been assigned the following loan for " & CustName & "." & "</p>" & vbNewLine & _
"<table style=""width:100%""><tr>" & _
"<th bgcolor=""#bdf0ff"">Product</th>" & _
"<th bgcolor=""#bdf0ff"">Loan Amount</th>" & _
"<th bgcolor=""#bdf0ff"">Closing Date</th>" & _
"<th bgcolor=""#bdf0ff"">Title Company</th>" & _
"<th bgcolor=""#bdf0ff"">Notes</th>" & _
"<th bgcolor=""#bdf0ff"">Contract Price</th></tr>"
<head><style>table, th, td {border: 1px solid gray; border-collapse:collapse;}</style></head><body><p>Hello Zack,<br><br>


Likewise the output is equally hard to read.

You have been assigned the following loan for Bugs.</p>
<table style="width:100%"><tr><th bgcolor="#bdf0ff">Product</th><th bgcolor="#bdf0ff">Loan Amount</th><th bgcolor="#bdf0ff">Closing Date</th><th bgcolor="#bdf0ff">Title Company</th><th bgcolor="#bdf0ff">Notes</th><th bgcolor="#bdf0ff">Contract Price</th></tr><tr><td "col width=10%">Product</td><td "col width=10%">Loan Amt</td><td "col width=10%">12/3/2019</td><td "col width=10%">Acme Title</td><td "col width=10%">Notes</td><td "col width=10%">Price</td></tr></table></body>


Writing well formatted code that produces well formatted html will make it much easier to read, write and modify procedures.

Although bgcolor is supported by Outlook Mail html editor, it is depreciated. Use background-color instead.

"<td ""col width=10%"">"


col is not an attribute, it is a html tag. I recommend using any relevant table section tags (Col tags belong in a colgroup, column headers a tr in the thead, standard cells in a tr in the tbody...etc.)

Using single quotes will make your code easier to read.

<col width='10%'>


Why use inline styles when you have a style tag?

"<th bgcolor=""#bdf0ff"">Product</th>"

.HTMLBody = strAll & "<br>" & .HTMLBody


Replace the HTMLBody altogether, don't concatenate it to your html. The default HTMLBody could potentially cause your message to display improperly.

Generating the html template, compiling the table rows, and creating the MailItem should be separate functions called by the Worksheet_Change event. This will make it easier to test each part of the code.

## Sample Code

Notice that I put a Stop after I display the message. This allows me to make changes to the functions that generate the html and update the message htmlbody. This is a massive time saver.

Option Explicit

Public Const TBodyMarker As String = "@tbody"

Sub CreateTestEmail()

Dim Outlook As Object
Set Outlook = CreateObject("Outlook.Application")

Dim MailItem As Object
Set MailItem = Outlook.CreateItem(0)

With MailItem
Const olFormatHTML As Long = 2
.BodyFormat = olFormatHTML
.HTMLBody = TestMessage
.Display

Stop
End With

End Sub

Function TestMessage() As String
Dim HTMLBody As String
HTMLBody = getLoanMessageHTML

Dim TBody As String
TBody = getTR("Clothing", "$10,000", #1/1/2020#, "Acme Title", "Blah Blah Blah", "$200.00")
TBody = TBody & vbNewLine & getTR("Purses", "$1000", #12/1/2019#, "Acme Title", "Blah Blah Blah", "$50.00")
HTMLBody = Replace(HTMLBody, TBodyMarker, TBody)
TestMessage = HTMLBody
End Function

Function getLoanMessageHTML()
Dim list As Object
Set list = CreateObject("System.Collections.Arraylist")
list.Add "<html>"
list.Add Space(2) & "<head>"
list.Add Space(4) & "<style>"
Rem Table
list.Add Space(6) & "table {"
list.Add Space(8) & "width:100%;"
list.Add Space(6) & "}"
Rem Table TH TD
list.Add Space(6) & "table, th, td {"
list.Add Space(8) & "border:1px solid gray;"
list.Add Space(8) & "border-collapse:collapse;"
list.Add Space(6) & "}"
Rem TH
list.Add Space(6) & "th {"
list.Add Space(8) & "background-color:#bdf0ff;"
list.Add Space(6) & "}"
list.Add Space(4) & "</style>"
list.Add Space(2) & "<head>"
list.Add Space(2) & "<body>"
Rem Message To Zack
list.Add Space(4) & "<p>Hello Zack,<br><br>"
Rem Table
list.Add Space(4) & "<table>"
Rem Column Group
list.Add Space(6) & "<colgroup>"
list.Add Space(8) & "<col width='10%'>"
list.Add Space(8) & "<col width='10%'>"
list.Add Space(8) & "<col width='10%'>"
list.Add Space(8) & "<col width='10%'>"
list.Add Space(8) & "<col width='10%'>"
list.Add Space(8) & "<col width='10%'>"
list.Add Space(6) & "</colgroup>"
Rem THead
list.Add Space(6) & "<thead>"
list.Add Space(8) & "<tr>"
list.Add Space(10) & "<th>Product</th>"
list.Add Space(10) & "<th>Loan Amount</th>"
list.Add Space(10) & "<th>Closing Date</th>"
list.Add Space(10) & "<th>Title Company</th>"
list.Add Space(10) & "<th>Notes</th>"
list.Add Space(10) & "<th>Contract Price</th>"
list.Add Space(8) & "</tr>"
list.Add Space(6) & "</thead>"
list.Add Space(6) & "<tbody>"
Rem TBody
list.Add Space(6) & TBodyMarker
list.Add Space(6) & "</tbody>"
list.Add Space(4) & "</table>"
list.Add Space(2) & "</body>"
list.Add "</html>"

getLoanMessageHTML = Join(list.ToArray, vbNewLine)
End Function

Function getTR(ParamArray TDValues() As Variant)
Dim list As Object
Set list = CreateObject("System.Collections.Arraylist")
Dim Item As Variant
list.Add Space(8) & "<tr>"
For Each Item In TDValues
list.Add Space(10) & "<td>" & Item & "</td>"
Next
list.Add Space(8) & "</tr>"
getTR = Join(list.ToArray, vbNewLine)
End Function


Having formatted output will also save you a lot of time and aggravation in the long run.

<html>
<head>
<style>
table {
width:100%;
}
table, th, td {
border:1px solid gray;
border-collapse:collapse;
}
th {
background-color:#bdf0ff;
}
</style>
<head>
<body>
<p>Hello Zack,<br><br>
<table>
<colgroup>
<col width='10%'>
<col width='10%'>
<col width='10%'>
<col width='10%'>
<col width='10%'>
<col width='10%'>
</colgroup>
<thead>
<tr>
<th>Product</th>
<th>Loan Amount</th>
<th>Closing Date</th>
<th>Title Company</th>
<th>Notes</th>
<th>Contract Price</th>
</tr>
</thead>
<tbody>
<tr>
<td>Clothing</td>
<td>$10,000</td> <td>1/1/2020</td> <td>Acme Title</td> <td>Blah Blah Blah</td> <td>$200.00</td>
</tr>
<tr>
<td>Purses</td>
<td>$1000</td> <td>12/1/2019</td> <td>Acme Title</td> <td>Blah Blah Blah</td> <td>$50.00</td>
</tr>
</tbody>
</table>
</body>
</html>


The sample code above is just a mockup. In practice I might store the html template in a textbox for easier viewing and modifications. I would also write a message class with settings to save, send or display the email. IMO having it all wrapped up in a class will make it easier to test.

## Sample Class: EmailIyem

Option Explicit

Private MailItem As Object
Private Outlook As Object

Public Property Get GetMailItem() As Object
Rem Some Code
End Property

Public Property Get GetOutlook() As Object
Rem Some Code
End Property

Public Function CreateMailItem() As Object
If Not MailItem Is Nothing Then
Rem What do you want to do here?
Rem Do you want to throw an Error?
Rem Or have a Msgbox() propting to replace the current MailItem?
End If
If Outlook Is Nothing Then
Rem What do you want to do here?
Set Outlook = CreateObject("Outlook.Application")
End If

Set MailItem = Outlook.CreateItem(0)
End Function

Public Function Send() As Boolean
Rem Raise Error if MailItem is Nothing
Rem Attempt to Send the MailItem and return the True if sent
End Function

Public Sub Display()
Rem Raise Error if MailItem is Nothing
MailItem.Display
End Sub

Public Function Save() As Boolean
Rem Raise Error if MailItem is Nothing
Rem Attempt to Save the MailItem and return the True if Saved
End Function

Public Property Get HTMLBody() As String
Rem Raise Error if MailItem is Nothing
HTMLBody = Me.GetMailItem.HTMLBody
End Property

Public Property Let HTMLBody(ByVal newHTMLBody As String)
Rem Raise Error if MailItem is Nothing
Me.GetMailItem.HTMLBody = newHTMLBody
End Property

Public Property Get Subject() As String
Rem Raise Error if MailItem is Nothing
Subject = Me.GetMailItem.Subject
End Property

Public Property Let Subject(ByVal newSubject As String)
Rem Raise Error if MailItem is Nothing
Me.GetMailItem.Subject = newSubject
End Property

Public Property Get BCC() As String
Rem Raise Error if MailItem is Nothing
BCC = Me.GetMailItem.BCC
End Property

Public Property Let BCC(ByVal newBCC As String)
Rem Raise Error if MailItem is Nothing
Me.GetMailItem.BCC = newBCC
End Property

Public Property Get CC() As String
Rem Raise Error if MailItem is Nothing
CC = Me.GetMailItem.CC
End Property

Public Property Let CC(ByVal newCC As String)
Rem Raise Error if MailItem is Nothing
Me.GetMailItem.CC = newCC
End Property


This is just a rough muck-up. The purpose of the class is to encapsulate the methods, settings and error handling associated for working with MailItems. Avoid adding feature that are specific to the current project. These features can easily be implemented in another class or module. Keeping the logic separate from the implementation will allow you to reuse the class in many other projects.

For example:

Instead of hard coding an html template and having a routine that builds a specific table, you could create a Template property and a InsertHTML method.

Public Property Get HTMLTemplate() As String

End Property

Public Property Let HTMLTemplate(ByVal newHTMLTemplate As String)

End Property

Public Function InsertHTML(ByVal Find As String, ByVal Replacement As String) As Boolean
If InStr(Me.HTMLTemplate, Find) > 0 Then
Me.HTMLTemplate = Replace(Me.HTMLTemplate, Find, Replacement)
InsertHTML = True
End If
End Function

• Thank you. I'm just now starting to learn my way around the class modules. Would you be willing to show me a small sample of how you would wrap everything up in a class? – Zack E Dec 4 '19 at 12:19
• @ZackE I added a rough outline and explanation of what an email item class might look like. – TinMan Dec 4 '19 at 13:59
• Thanks for the sample of a class module. I probably wont utilize it in this project because of the simple fact Class Modules are still above my skill set at this stage; however, the information you have provided is going to be a great resource for the very near future. – Zack E Dec 4 '19 at 14:13
• Classes are easier than you think. I wouldn't modify this project unless it was a necessity. Wait till it comes time to add new features. By then you will undoubtedly have learned a lot more and will want to rewrite it anyway. – TinMan Dec 4 '19 at 15:37
• only thing that isnt working is the body of the email is not adding the default signatue. – Zack E Dec 5 '19 at 15:17

I will assume you have used Option Explicit at the top of every module.

Some kudos up front:

• Declaration of variables where you are going to use them
• Reasonable indenting (why the additional indent for For Each cell In RgSel?)
• Reasonable variable names (although lamount could be loanAmount)

## Explicit range calls

I see one potential 'gotcha' in the code:

Set RgCell = Range("C3:C100")


Always fully qualify cells. In your code above, this is the only time you explicitly call a range, which minimises the impact (good design choice!). In this case, you are using the code in a Worksheet module and I am assuming that the range you want to use is also on this worksheet. So the change is simply:

Set RgCell = Me.Range("C3:C100")


But then, I ask the question - why C3 to C100? Why not C99 or C1000? In Excel, you can use named ranges. Used properly, they will shrink and grow as you add/remove cells - meaing that you can dispense with magic numbers and guessing the count of cells! So in this case, you could call the range of cells 'ApplicantNames'. The resultant code could look like either of the two below:

Set RgCell = Me.Range("ApplicantNames")
Set RgCell = Me.Names("ApplicantNames").RefersToRange


The Worksheet_Change event trigger may sometimes be something other than a user interaction, so the active sheet may not be what you think it is.

## Know when to stop referring to Excel objects

At some point in the code, you are using Excel as a database. In this case, it is very early. Every time the code makes a reference to a Range or some other Excel-specific action, the code has to switch from the VBA Engine to the Excel Engine. This costs in terms of performance. In your case, it may not be noticeable because you are likely only dealing with a few rows. But if you were to deal with a 1000 rows, you would certainly notice the performance hit!

Seeing as you don't do anything to the excel data itself, you can make a single call to the Excel part, collect all the data and then work exclusively in the VBA engine. This is done by arrays.

Set RgSel = Intersect(Target, RgCell)
Set RgSel = RgSel.Offset(0,-1)
Set RgSel = RgSet.Resize(,18) ' based on the offsets you used in the original code
Dim myData as Variant
myData = RgSel.Value


'myData' is now a 2-D array.

For Each cell In RgSel


Now becomes

For someIterator = LBound(myData, 1) to UBound(myData, 1) ' iterate through the rows


And, as an example, you can then get your key information like:

TitleCo = myData(someIterator, 3)


## Magic Numbers

Try and avoid magic numbers (and strings) by declaring them as public constants in their own module. This makes them obvious, and you know where to find them if you want to change them.

Examples of magic numbers and the resultant code:

If LCase(cell.Value) = "zack" Then ' <-- or did you mean 'recipient' in this case?

Public Const SUBJECTPREFIX As String = "***NEW LOAN ASSIGNED***" & " - "
Subj = SUBJECTPREFIX & UCase(CustName)

Public Const TDCOLWIDTH As String = "<td ""col width=10%"">"

Dim strRows As String
strRows = strRows & "<tr>"
strRows = strRows & TDCOLWIDTH & Product & "</td>"
strRows = strRows & TDCOLWIDTH & lamount & "</td>"
strRows = strRows & TDCOLWIDTH & ClsDate & "</td>"
strRows = strRows & TDCOLWIDTH & TitleCo & "</td>"
strRows = strRows & TDCOLWIDTH & Notes & "</td>"
strRows = strRows & TDCOLWIDTH & ContractPrice & "</td>"
strRows = strRows & "</tr>"

Public Const BODYLEADER as String = "<head><style>table, th, td {border: 1px solid gray; border-collapse:" & "collapse;}</style></head><body>" & _
"<p>" & "Hello "
Public Const BODYINTRO As String = ", <br><br>" & vbNewLine & vbNewLine & _
"You have been assigned the following loan for "
Public Const BODYTABLEHEADERS As String = "." & "</p>" & vbNewLine & _
"<table style=""width:100%""><tr>" & _
"<th bgcolor=""#bdf0ff"">Product</th>" & _
"<th bgcolor=""#bdf0ff"">Loan Amount</th>" & _
"<th bgcolor=""#bdf0ff"">Closing Date</th>" & _
"<th bgcolor=""#bdf0ff"">Title Company</th>" & _
"<th bgcolor=""#bdf0ff"">Notes</th>" & _
"<th bgcolor=""#bdf0ff"">Contract Price</th></tr>"

strBeforeRows = BODYLEADER & Recipient & BODYINTRO & CustName & BODYTABLEHEADERS


As I noted above, the declaration of the magic numbers should be in their own module, not mixed with the code as I have done here. Even if you use the Const only once in the code, this is good code hygiene because it makes magic numbers obvious, it makes the easier to find and thus makes the code easier to maintain. In addition, the actual code now is self commenting - previously there was a wall of string that people had to guess what it actually meant.

In the case of TABLEHEADERS and TDCOLWIDTH, if you add another column, you can now have the two lines of code adjacent to each other, and you are less likely to forget to amend the column widths to suit the new headers!

## Finally

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Application.DisplayAlerts = True
Application.ScreenUpdating = True


With the code in the OP, .ScreenUpdate = False does nothing, because no events exist that cause the screen to repaint. I am not sure that any alerts will be generated by Excel either. With a change to using arrays, performance should not be an issue.

• Thank you for the very detailed explanation. Yes, Option Explicit is at the top of the module. I keep forgetting about the Public Const and need to start to use that more. I will definitely make the adjustments when I am able to get back to this project. I will let you know how it goes and accept the answer once ive tested everything out. – Zack E Dec 3 '19 at 20:30
• I used a hybrid of your suggestions and TinMan's, but since I used more of TinMan's suggestions and edits I accepted his answer. Thank you again for the very helpful information. Both you and TinMan have taught me a lot in my last few posts. – Zack E Dec 5 '19 at 14:08
• The Signature must be apart of the original HTMLBody. Try inserting the new html into the beginning of the MailItem.HTMLBody  like you were doing. (e.g. MailItem.HTMLBody = NewHTML & MailItem.HTMLBody) – TinMan Dec 5 '19 at 15:26