Making worksheet VBA function for workbook

Question

I'm trying to put the VBA in the workbook object rather then each sheet but am not having any luck. I'm thinking I need to use Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Source As Range) but not sure how to implement. Anyone have a solution to get this code to work in "ThisWorkbook" rather then placing it on each sheet?

Dim xRg As Range
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Target.Cells.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("L13:L5000")) Is Nothing Then
            If IsDate(Target.Value) And Target.Value > 0 Then
               targetRow = Target.Row
               offsetRow = Target.Offset(9, 0).Row
               Dim bIsNinthRow As Boolean
                Dim ModResult As Long
                bIsNinthRow = False
                ModResult = (targetRow - 13) Mod 9
                If ModResult = 0 Then bIsNinthRow = True
                If bIsNinthRow Then Call Mail_small_Text_Outlook(targetRow, offsetRow)
            End If
    End If

End Sub
Sub Mail_small_Text_Outlook(targetRow, offsetRow)
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xMailBody As String
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    xMailBody = "Hello" & vbNewLine & vbNewLine & _
              "This client is now Committed & Complete and ready for your attention" & vbNewLine & vbNewLine & _
              "Renew As Is?" & vbNewLine & _
              "Adding Changing Groups?"


    On Error Resume Next
    With xOutMail
        .To = ""
        .CC = ""
        .BCC = ""
        .Subject = "Committed & Complete" & "  " & ActiveCell.Offset(-4, -11).Value & "  " & ActiveCell.Offset(-4, -9).Value
        .Body = xMailBody
        .Display   'or use .Send
    End With
    On Error GoTo 0
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub

This post is about UserForm events, but the exact same recommendation applies: DO NOT, under any circumstances, type up event handlers manually. — Mathieu Guindon
You cannot put a worksheet event handler in a workbook. It does not have that event. — braX

AJD AJD · Accepted Answer · 2019-09-19T21:20:27

@MathieuGuindon provided very sage advice in the comments, which I will summarise here:

DO NOT, under any circumstances, type up event handlers manually.

not sure how to implement - the only difference is that you get a Sh parameter holding a reference to the modified sheet. ....and it's useless, because you can already get that with Target.Parent. The one thing you need to worry about is implicit ActiveSheet references

Use your VBA IDE (that view/application/window that you found your screenshot from). Open up the code for 'ThisWorkbook'. At the top of that code window, you will see two drop-down boxes.

Selecting 'WorkBook' in the left dropdown and 'SheetChange' in the right dropdown will automatically post this code:

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

End Sub

As you can see Target is used, not Source, in the automated text. So most of your code is unchanged. As a side note, you could modify that to 'Source' or 'FrostyTheSnowman' (thanks - @MathieuGuindon) and then modify your code accordingly but why make extra work for yourself (see Note 1 at end).

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
        If Not Intersect(Target, Target.Parent.Range("L13:L5000")) Is Nothing Then
            If IsDate(Target.Value) And Target.Value > 0 Then
                targetRow = Target.Row
                offsetRow = Target.Offset(9, 0).Row
                Dim bIsNinthRow As Boolean
                Dim ModResult As Long
                bIsNinthRow = False
                ModResult = (targetRow - 13) Mod 9
                If ModResult = 0 Then bIsNinthRow = True
                If bIsNinthRow Then Call Mail_small_Text_Outlook(targetRow, offsetRow)
            End If
    End If
End Sub

You can see from the above, I only made one small change - that is qualifying one statement.

        If Not Intersect(Target, Target.Parent.Range("L13:L5000")) Is Nothing Then

I could have used the Sh Object as well (Intersect(Target, Sh.Range("L13:L5000"))), however, type checking would be required for peace of mind.

But

Your current design has a small flaw - and that is in your helper function Sub Mail_small_Text_Outlook(targetRow, offsetRow).

You pass two variants into the routine, you don't use these variants (which is currently a blessing for you) and we can't tell what they are meant to be. Importantly, though, your code uses a ActiveCell construct - but you cannot guarantee what the active cell will be when you call the code.

You have the bones here, define the exact range (or better yet, the actual value) that you want to use in your Mail_small_Text_Outlook and then use that. This makes the routine much more re-usable at a latter date rather then your current construct which relies on a hard coded offset.

Sub Mail_small_Text_Outlook(ByVal dataElement1 as String, ByVal dataElement2 as String) 'Meaningful names and types required, I am guessing.
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xMailBody As String
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    xMailBody = "Hello" & vbNewLine & vbNewLine & _
              "This client is now Committed & Complete and ready for your attention" & vbNewLine & vbNewLine & _
              "Renew As Is?" & vbNewLine & _
              "Adding Changing Groups?"


    With xOutMail
        .To = ""
        .CC = ""
        .BCC = ""
        .Subject = "Committed & Complete" & "  " & dataElement1  & "  " & dataElement2
        .Body = xMailBody
        .Display   'or use .Send
    End With
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub

This means a small change to your 'Change' routine:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
        If Not Intersect(Target, Target.Parent.Range("L13:L5000")) Is Nothing Then
            If IsDate(Target.Value) And Target.Value > 0 Then
                Dim data1 as string, data2 as string
                data1 = Target.Offset(-4, -11).Value
                data2 = Target.Offset(-4, -9).Value
                If (Target.Row - 13) Mod 9 = 0 Then Mail_small_Text_Outlook(data1, data2)
            End If
    End If
End Sub

I have also cleaned up some of the unnecessary lines - the extra declarations etc weren't wrong, but all those extra steps could be done simply in a single line as shown. If there is a design reason for every ninth row, then a simple one line comment can explain that to a future maintainer of the code.

Standard comments

Always. Always. Always. Always. Use Option Explicit.

Call is obsolete and at one stage was noted in the VBA documents as being deprecated. It is unnecessary clutter.

Be very wary of using On Error statements, especially for parts of code where you can control/validate the inputs and manage expected errors yourself. These can hide basic coding errors and you will spend hours looking for something when you don't get the right results, or - even worse - you will just accept wrong results without knowing that an error has occurred.

Note 1: With event handlers, what is important is that the number and types of parameters line up with the event description. The names of the variables used in the event handler signature (e.g. Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)) can be whatever you want.

Note 2: IDE - Integrated Development Environment

Making worksheet VBA function for workbook

1 Answers

But

Standard comments