# Add items to Dictionary from another dictionary on cell value change

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

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.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
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
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
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
Dim uName As String, pName As String

pName = "zack"

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

If uName = "zacke" Then
StoreOriginalLoanInfo pName, pLastRow
Else
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
End If

End Function

• How are you storing the dictionary? Is it a global variable? How is it initiated? – TinMan Dec 5 '19 at 23:00
• @TinMan the data is passed from the variables set in the class module and the initiating even comes from a sub routine that tests if the workbook is in read only mode. I can post that procedure tomorrow when I'm back in the office if that helps. – Zack E Dec 6 '19 at 0:13
• You should post it. – TinMan Dec 6 '19 at 3:27
• @TinMan I added the information you requested. – Zack E Dec 6 '19 at 13:45

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
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
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
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
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

• Thank you for this. It really helped give me more understanding in how to use a Class Module and also how to use a dictionary. I did make some tweaks to it because the LoanNumber is going to be the key for the dictionary. Thanks again! – Zack E Dec 6 '19 at 15:03