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