(Solved) – RTE 438: Object Doesnt Support this property or Method – Updating existing item values based on dictionary key

  • by

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 Module

'--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))
            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
        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!"
        If allLoans.Count = 0 Then
            Debug.Print "There is a loan dictionary, but it's empty!"
            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

Leave a Reply

Your email address will not be published. Required fields are marked *