Add items to Dictionary from another dictionary on cell value change

Question

I have created a very simple Class Module and a Dictionary to store original values when the workbook is opened as part of this project ive been working on. When the workbook opens I call a test to see if its open in read only mode because multiple people will be in the workbook, but only one person will have it open for editing.
Currently the project sends an email when a file is assigned to an individual, but now i need to track any changes to cells in certain columns and send out an email based on that. The email part i have figured out already with help from This Post.

I also need to be able to add an item to the existing dictionary, which is the part I am struggling on, when a number is added to a cell in a named range. Unfortunately, the research I have done isnt really explained well or not a close enough example to what I am looking to do. Thanks for you help.

Class Module

'clsLoanData
Public LoanAmount As String
Public TitleCompany As String
Public Notes As String
Public CloseDate As String
Public PurchasePrice As String
Public Product As String
Public LoanNumber As String
Public CustomerName As String

Worksheet_Change Event

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Dim Recipient As String
    Recipient = "zack"

    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

    Dim rgCells As Range
    Set rgCells = Me.Range("pNames")

    Dim rgSel As Range
    Set rgSel = Intersect(Target, rgCells)

    Dim cell As Range

    If Not rgSel Is Nothing Then
        For Each cell In rgSel
            If LCase(cell.Value) = Recipient Then
            Dim oLoan As New clsLoanData
                With oLoan
                    .LoanAmount = Format(Trim(cell.Offset(0, 14).Value), "Currency")
                    .CloseDate = Trim(cell.Offset(0, 8).Value)
                    .Notes = Trim(cell.Offset(0, 17).Value)
                    .LoanNumber = Trim(cell.Offset(0, -2).Value)
                    .Product = Trim(cell.Offset(0, 15).Value)
                    .PurchasePrice = Format(Trim(cell.Offset(0, 13).Value), "Currency")
                    .TitleCompany = Trim(cell.Offset(0, 2).Value)
                    .CustomerName = Trim(Split(cell.Offset(0, -1).Value, " - ")(0))
                    CreateEmail oLoan.CustomerName, oLoan.TitleCompany, oLoan.CloseDate, _
                                oLoan.PurchasePrice, oLoan.LoanAmount, oLoan.Product, oLoan.Notes
                End With

                'Dim LoanInfoDict As Object
                'Set LoanInfoDict = CreateObject("Scripting.Dictionary")

                'Set LoanInfoDict = StoreOriginalLoanInfo("zacke")
                'THIS IS WHERE I AM STUCK SINCE I DONT KNOW HOW TO ADD TO
                'AN EXISTING DICTIONARY.


        Next cell
    End If

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

    Dim lNum As Range
    Set lNum = Me.Range("LoanNums")

    'Dim c As Range
    'Set c = Sheet1.Range("pNames")

    If Not Intersect(Target, lNum) Is Nothing Then
        Dim cAddress As String
        cAddress = Target.Address
        StoreNewLoanNumberInfo cAddress
    End If



End Sub

Functions

Option Explicit
Function StoreOriginalLoanInfo(ByVal pName As String, Optional ByVal lNum) As Dictionary

    Dim OriginalLoanInfo As Object
    Set OriginalLoanInfo = CreateObject("Scripting.Dictionary")

    'OriginalLoanInfo.RemoveAll

    Dim c As Range
    Dim cCell As Range

    Set c = Sheet1.Range("pNames")

    For Each cCell In c.Cells
        If LCase(cCell.Value) = pName Then
            Dim oLoan As New clsLoanData
                With oLoan
                    .LoanAmount = Trim(cCell.Offset(0, 14).Value)
                    .CloseDate = Trim(cCell.Offset(0, 8).Value)
                    .Notes = Trim(cCell.Offset(0, 17).Value)
                    .LoanNumber = Trim(cCell.Offset(0, -2).Value)
                    .Product = Trim(cCell.Offset(0, 15).Value)
                    .PurchasePrice = Trim(cCell.Offset(0, 13).Value)
                    .TitleCompany = Trim(cCell.Offset(0, 2).Value)
                    .CustomerName = Trim(Split(cCell.Offset(0, -1).Value, " - ")(0))
                End With
            If Not OriginalLoanInfo.Exists(oLoan.LoanNumber) And oLoan.LoanNumber <> vbNullString Then
                OriginalLoanInfo.Add oLoan.LoanNumber, oLoan
                With oLoan
                    Debug.Print .LoanNumber, .CustomerName, .CloseDate, .LoanAmount, .Notes, .Product, .PurchasePrice, .TitleCompany
                End With
            End If
        End If
    Next cCell

    Set StoreOriginalLoanInfo = OriginalLoanInfo

End Function

    'The end goal is to have this added to the StoreOriginalLoanInfo Dictionary
    'when a number is added to column A
    Function StoreNewLoanNumberInfo(ByVal cell As String) As Dictionary
        Dim NewLoanInfo As Object
        Set NewLoanInfo = CreateObject("Scripting.Dictionary")

        Dim ln As Range
        Set ln = Sheet1.Range("LoanNums")

        Dim c As Range
        Set c = Sheet1.Range(cell)

        Dim oLoan As New clsLoanData
        With oLoan
            .LoanAmount = Trim(c.Offset(0, 16).Value)
            .CloseDate = Trim(c.Offset(0, 10).Value)
            .Notes = Trim(c.Offset(0, 19).Value)
            .LoanNumber = Trim(c.Value)
            .Product = Trim(c.Offset(0, 17).Value)
            .PurchasePrice = Trim(c.Offset(0, 15).Value)
            .TitleCompany = Trim(c.Offset(0, 4).Value)
            .CustomerName = Trim(Split(c.Offset(0, 1).Value, " - ")(0))
        End With

        If Not NewLoanInfo.Exists(oLoan.LoanNumber) Then
            NewLoanInfo.Add oLoan.LoanNumber, oLoan
                With oLoan
                    Debug.Print .LoanNumber, .CustomerName, .CloseDate, .LoanAmount, .Notes, .Product, .PurchasePrice, .TitleCompany
                End With
        End If

        Set StoreNewLoanNumberInfo = NewLoanInfo

    End Function

EDIT Below is the procedure and function to test if the file is in read only mode per TinMan's request. The reason I have these is because I only want the dictionary with the loan information to populate when the workbook is first opened by the user who will be editing the worksheet. This data will be used to compare against new data entered for an additional email that something has been updated.

Option Explicit
Sub testReadOnly()
    Dim uName As String, pName As String

    pName = "zack"

    uName = LCase(Environ("username"))

    Dim pLastRow As Long
    pLastRow = Sheet1.Cells(Sheet1.Rows.Count, "C").End(xlUp).Row

    If uName = "zacke" Then
        If Not isReadOnly(PIPELINEFILE) Then
            StoreOriginalLoanInfo pName, pLastRow
        Else
            MsgBox "File Is Read-Only"
        End If
    End If

End Sub
Function isReadOnly(ByVal fName As String) As Boolean

    'vbNormal = 0, vbReadOnly = 1, vbHidden = 2, vbDirectory = 16
    If Len(fName) > 0 Then
        isReadOnly = GetAttr(fName) And vbReadOnly
    End If

End Function

Answer 1

Hopefully this example will help you to organize and simplify your project design. Overall, your code is fairly clean but it can be simplified mostly by focused on what parts of your code are repeated and redundant. In particular, you have several code sections that collect the loan details using Offset on the worksheet. All of the offsets are the same, plus you have encapsulated all of the loan details into it's own class. So make the class do the work:

Class Module: LoanData

Option Explicit

'--- Class: LoanData
Public LoanAmount As String
Public TitleCompany As String
Public Notes As String
Public CloseDate As String
Public PurchasePrice As String
Public Product As String
Public LoanNumber As String
Public CustomerName As String

Public Sub Populate(ByRef loanDetails As Range)
    With loanDetails
        LoanAmount = Format(Trim(.Offset(0, 14).Value), "Currency")
        CloseDate = Trim(.Offset(0, 8).Value)
        Notes = Trim(.Offset(0, 17).Value)
        LoanNumber = Trim(.Offset(0, -2).Value)
        Product = Trim(.Offset(0, 15).Value)
        PurchasePrice = Format(Trim(.Offset(0, 13).Value), "Currency")
        TitleCompany = Trim(.Offset(0, 2).Value)
        CustomerName = Trim(Split(.Offset(0, -1).Value, " - ")(0))
    End With
End Sub

And by the way, my personal preference is to NOT prefix custom classes with cls. There's no reason for it and you can distinguish your own classes from the VBA built-ins anyway. Trust me, no one will be confused thinking that LoanData is built in to the language. Notice how the class supplies a method to populate itself, given a cell Range as a reference for your Offset.

SIDE NOTE 1: I would likely have declared the LoanAmount and PurchasePrice variables as Double, then deferred to the calling routine to decide how to format those values for output. By forcing those values as String here, you've prevented possible future operations if you wanted to, for example, sum all the loan values for a given zip code or something.

SIDE NOTE 2: the dictionary code is implemented as you presented it, but I am concerned that your "Key" value for the Dictionary is not guaranteed to be unique for all possibilities. Your key looks like it is the CustomerName (recipient?). You might consider what field or fields you'd need to consider for a truly unique identifier. I would think the LoanNumber would be unique enough. Or a combination of LoanNumber and CustomerName perhaps.

It's easiest to describe the general methods that deal with the Dictionary directly before considering the worksheet change events.

First, I recommend using early binding for the Microsoft Scripting Runtime, at least to start your coding and debugging. It will make the Dictionary easier to work with.

Next, when you need to reference a (semi-)persistent (global) variable, you declare this at the top of a regular VBA code module. In my example, the variable allLoans is declared as Private. All interactions with this dictionary are performed from publicly available routines (which is desirable), so keep the dictionary private here. The basic workhorse of the project is UpdateLoanDictionary. This is the routine that will create a new entry or modify an existing entry:

Private allLoans As Dictionary

Public Sub UpdateLoanDictionary(ByRef thisCustomer As Range)
    '--- just in case this Sub is called before the dictionary is created
    If allLoans Is Nothing Then CreateLoanDictionary
    If IsEmpty(thisCustomer.Value) Then Exit Sub

    Dim thisLoan As LoanData
    Set thisLoan = New LoanData
    thisLoan.Populate thisCustomer

    If Not allLoans.Exists(thisLoan.CustomerName) Then
        '--- create a new loan entry
        allLoans.Add thisLoan.CustomerName, thisLoan
    Else
        '--- update the existing loan entry
        allLoans(thisLoan.CustomerName) = thisLoan
    End If
End Sub

(the whole module is given in a single block below)

Notice that is takes a single-cell range as the input parameter. This will be used to check the data and to create an object with the LoanData we need. (More about how to create the whole dictionary below.)

SIDE NOTE 3 - VERY IMPORTANT: create your new LoanData object with a separate New statement as shown above. Your method is Dim oLoan As New clsLoanData in a single statement. This declares a "static" class, i.e. an object that is created ONCE and only once. You want to create many of these LoanData objects, so you want a dynamic declaration that will create a new object each time.

Now, there are two conditions in which you want to create your dictionary: when the workbook opens for the first time and also when the worksheet containing the data is activated. So these methods are simple.

Workbook Module: ThisWorkbook

Option Explicit

Private Sub Workbook_Open()
    CreateLoanDictionary
End Sub

Worksheet Module: Sheet1

Option Explicit

Private Sub Worksheet_Activate()
    CreateLoanDictionary
End Sub

So back in the VBA Code Module, there is an additional routine to support these conditions:

Public Sub CreateLoanDictionary(Optional ByVal forceNewDictionary As Boolean = False)
    '--- if the dictionary already exists, we don't have to recreate it
    '    unless it's forced
    If forceNewDictionary Or (allLoans Is Nothing) Then
        Set allLoans = New Dictionary
        Dim customerNames As Range
        Set customerNames = ActiveSheet.Range("pNames")
        Dim customer As Range
        For Each customer In customerNames
            UpdateLoanDictionary customer
        Next customer
    End If
End Sub

This is where the code will loop through all the data on your worksheet and create all the entries in your dictionary using the UpdateLoanDictionary method we defined earlier. (functional isolation FTW!)

The last bit is back in the worksheet module code, to respond to changes on the worksheet. Since we have the LoanData object doing all the work of setting up the loan details and the UpdateLoanDictionary method taking care of interacting with the dictionary, the Worksheet_Change event code is greatly simplified:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim customerNames As Range
    Set customerNames = ActiveSheet.Range("pNames")

    Dim allChangedCells As Range
    Set allChangedCells = Intersect(Target, customerNames)
    If Not allChangedCells Is Nothing Then
        Dim changedCell As Range
        For Each changedCell In allChangedCells
            AddLoanToDictionary changedCell
        Next changedCell
    End If
End Sub

SIDE NOTE 4: it's best in event code to make it as short and efficient as possible. That includes making your range Intersect check the very first thing in the Sub. Any other logic you need can work after you determine that you really need to do that work.

So here are the code modules in whole:

Class Module: LoanData

Option Explicit

'--- Class: LoanData
Public LoanAmount As String
Public TitleCompany As String
Public Notes As String
Public CloseDate As String
Public PurchasePrice As String
Public Product As String
Public LoanNumber As String
Public CustomerName As String

Public Sub Populate(ByRef loanDetails As Range)
    With loanDetails
        LoanAmount = Format(Trim(.Offset(0, 14).Value), "Currency")
        CloseDate = Trim(.Offset(0, 8).Value)
        Notes = Trim(.Offset(0, 17).Value)
        LoanNumber = Trim(.Offset(0, -2).Value)
        Product = Trim(.Offset(0, 15).Value)
        PurchasePrice = Format(Trim(.Offset(0, 13).Value), "Currency")
        TitleCompany = Trim(.Offset(0, 2).Value)
        CustomerName = Trim(Split(.Offset(0, -1).Value, " - ")(0))
    End With
End Sub

Workbook Module: ThisWorkbook

Option Explicit

Private Sub Workbook_Open()
    CreateLoanDictionary
End Sub

Worksheet Module: Sheet1

Option Explicit

Private Sub Worksheet_Activate()
    CreateLoanDictionary
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim customerNames As Range
    Set customerNames = ActiveSheet.Range("pNames")

    Dim allChangedCells As Range
    Set allChangedCells = Intersect(Target, customerNames)
    If Not allChangedCells Is Nothing Then
        Dim changedCell As Range
        For Each changedCell In allChangedCells
            AddLoanToDictionary changedCell
        Next changedCell
    End If
End Sub

(There's a bonus method below to ShowLoans that gave me a quick test of the dictionary. You can expand/modify it as needed.)

Code Module: LoanDataSupport

Option Explicit

Private allLoans As Dictionary

Public Sub CreateLoanDictionary(Optional ByVal forceNewDictionary As Boolean = False)
    '--- if the dictionary already exists, we don't have to recreate it
    '    unless it's forced
    If forceNewDictionary Or (allLoans Is Nothing) Then
        Set allLoans = New Dictionary
        Dim customerNames As Range
        Set customerNames = ActiveSheet.Range("pNames")
        Dim customer As Range
        For Each customer In customerNames
            UpdateLoanDictionary customer
        Next customer
    End If
End Sub

Public Sub UpdateLoanDictionary(ByRef thisCustomer As Range)
    '--- just in case this Sub is called before the dictionary is created
    If allLoans Is Nothing Then CreateLoanDictionary
    If IsEmpty(thisCustomer.Value) Then Exit Sub

    Dim thisLoan As LoanData
    Set thisLoan = New LoanData
    thisLoan.Populate thisCustomer

    If Not allLoans.Exists(thisLoan.CustomerName) Then
        '--- create a new loan entry
        allLoans.Add thisLoan.CustomerName, thisLoan
    Else
        '--- update the existing loan entry
        allLoans(thisLoan.CustomerName) = thisLoan
    End If
End Sub

Sub ShowLoans()
    If allLoans Is Nothing Then
        Debug.Print "This is no loan dictionary!"
    Else
        If allLoans.Count = 0 Then
            Debug.Print "There is a loan dictionary, but it's empty!"
        Else
            Debug.Print "There are " & allLoans.Count & " loans in the dictionary:"
            Dim loan As Variant
            For Each loan In allLoans.Items
                Debug.Print "Loan Number: " & loan.LoanNumber
            Next loan
        End If
    End If
End Sub