3
\$\begingroup\$

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
\$\endgroup\$
2
\$\begingroup\$

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
| improve this answer | |
\$\endgroup\$
  • \$\begingroup\$ 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? \$\endgroup\$ – Zack E Dec 4 '19 at 12:19
  • \$\begingroup\$ @ZackE I added a rough outline and explanation of what an email item class might look like. \$\endgroup\$ – TinMan Dec 4 '19 at 13:59
  • \$\begingroup\$ 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. \$\endgroup\$ – Zack E Dec 4 '19 at 14:13
  • 1
    \$\begingroup\$ 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. \$\endgroup\$ – TinMan Dec 4 '19 at 15:37
  • \$\begingroup\$ only thing that isnt working is the body of the email is not adding the default signatue. \$\endgroup\$ – Zack E Dec 5 '19 at 15:17
4
\$\begingroup\$

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.

| improve this answer | |
\$\endgroup\$
  • \$\begingroup\$ 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. \$\endgroup\$ – Zack E Dec 3 '19 at 20:30
  • \$\begingroup\$ 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. \$\endgroup\$ – Zack E Dec 5 '19 at 14:08
  • \$\begingroup\$ 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) \$\endgroup\$ – TinMan Dec 5 '19 at 15:26

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.