Im at a loss on why I am getting the Run Time Error of 438 when trying to update items in a dictionary based on the key. Please note I am still very new to using Dictionaries in VBA. I decided to use the cell address as the key, but I think this may cause an issue later on when rows are deleted and added; I will address this later if it does cause issues.
Back to the issue at hand: I am receiving the Run Time Error on
allLoans(thisLoanNum) = TempVal within the
Public Sub UpdateLoanDictionary(ByRef thisLoanNum As Range) when ever I update one of the cells within the specified ranges. I have placed all of the functions, class modules and subs in one code block, but if I need to split them up and label them as such I will. I have tried looping through the keys (current setup) and not looping through the keys in the
Worksheet_Change event, but both ways cause the same error.
Data Set: These are the columns with data the code looks at
Loan Number | Customer Name | Processor | Title Company | Closing Date | Contract Price | Loan Amount | Notes
'--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 ProcessorName As String Public Sub Populate(ByRef loanDetails As Range) With loanDetails LoanAmount = Trim(.Offset(0, 16).Value) closeDate = Trim(.Offset(0, 10).Value) Notes = Trim(.Offset(0, 19).Value) LoanNumber = .Offset(0, 0).Cells.Address Product = Trim(.Offset(0, 17).Value) PurchasePrice = Trim(.Offset(0, 15).Value) TitleCompany = Trim(.Offset(0, 4).Value) If CBool(InStr(1, .Offset(0, 1), " - ")) Then CustomerName = Trim(Split(.Offset(0, 1).Value, " - ")(0)) Else CustomerName = Trim(.Offset(0, 1).Value) End If ProcessorName = Trim(.Offset(0, 2).Value) End With End Sub
Worksheet Change Event
Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim loanNumbers As Range Set loanNumbers = Sheet1.Range("LoanNums,CloseDate,ContractPrice,LoanAmnt,LoanNotes,Product") Dim allChangedCells As Range Set allChangedCells = Intersect(Target, loanNumbers) If Not allChangedCells Is Nothing Then Dim changedCell As Range For Each changedCell In allChangedCells UpdateLoanDictionary changedCell Next changedCell Dim uLoan As New LoanData CreateEmail uLoan.CustomerName, uLoan.TitleCompany, uLoan.closeDate, uLoan.PurchasePrice, uLoan.LoanAmount, uLoan.Product, uLoan.Notes End If End Sub
Standard Module named 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 loanNums As Range Set loanNums = ActiveSheet.Range("LoanNums") Dim loannum As Range For Each loannum In loanNums UpdateLoanDictionary loannum Next loannum End If End Sub Public Sub UpdateLoanDictionary(ByRef thisLoanNum As Range) '--- just in case this Sub is called before the dictionary is created If allLoans Is Nothing Then CreateLoanDictionary 'If IsEmpty(thisLoanNum.Value) Then Exit Sub Dim thisLoan As LoanData Set thisLoan = New LoanData thisLoan.Populate thisLoanNum If Not allLoans.Exists(thisLoan.LoanNumber) Then '--- create a new loan entry allLoans.Add thisLoan.LoanNumber, thisLoan Else Dim loanKey As Variant For Each loanKey In allLoans.Keys Dim TempVal As New LoanData allLoans(thisLoanNum) = TempVal Next loanKey '--- update the existing loan entry 'allLoans(thisLoanNum) = thisLoan <--This causes same error as the loop. End If End Sub Sub ShowLoans() If allLoans Is Nothing Then Debug.Print "There 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 & "Notes: " & loan.Notes Next loan End If End If End Sub
Forgot to give credit to the fine people that helped me on Code Review with originally helping me with this code from This Post