Updating Records Quickly using Arrays

[ianawwalker]

Hello,

I am struggling to get my code to work and appreciate any help.

There are two worksheets that I am trying to compare to each other and update the row(s) (5 different cells in that row only), but only update if there is a "N" on the 'records' worksheet and my 'offline' worksheet has a "Y". I have loan numbers in my 'offline' worksheet that will match a specific cell in a row on the 'records' worksheet, then it only needs to update the 5 different cells if there is the "N" on the 'records' tab and my 'offline' tab has a 'Y'. The code below has it replace the whole row on the records tab with the offline tab, but don't want this to replace the whole row. I don't have much experience with arrays but am attempting to use the arrays to match the data faster. Let me know if you want or need additional details. Thank you in advance!

Sub UpdateRecords()
    Dim offlineData As Variant
    Dim recordsData As Variant
    Dim postingDict As Object
    Dim i As Long
    Dim j As Long
    Dim numOfflineRows As Long
    Dim numRecordsRows As Long
    Dim loanNum As String
    Dim offlinerecord As Long
    
    ' Read data from sheets into arrays
    offlineData = Sheets("offline").Range("A3").Resize(, 65).Value
    recordsData = Sheets("Records").Range("StartSpot").Resize(, 65).Value
    
    ' Create a dictionary to store loan numbers from the offline data
    Set postingDict = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(offlineData, 1)
        loanNum = offlineData(i, 1)
        If Not postingDict.Exists(loanNum) Then
            postingDict.Add loanNum, i
        End If
    Next i
    
    ' Loop through the offline data and update records data
    numOfflineRows = UBound(offlineData, 1)
    numRecordsRows = UBound(recordsData, 1)
    For i = 1 To numOfflineRows
        loanNum = offlineData(i, 1)
        If postingDict.Exists(loanNum) Then
            offlinerecord = postingDict(loanNum) - 3
            For j = 1 To 65
                recordsData(offlinerecord, j) = offlineData(i, j)
            Next j
        Else
            numRecordsRows = numRecordsRows + 1
            ' Resize recordsData if needed
            If numRecordsRows > UBound(recordsData, 1) Then
                ReDim Preserve recordsData(1 To numRecordsRows, 1 To 65)
            End If
            For j = 1 To 65
                recordsData(numRecordsRows, j) = offlineData(i, j)
            Next j
        End If
    Next i
    
    ' Write updated records data to sheet
    Sheets("Records").Range("StartSpot").Resize(numRecordsRows, 65).Value = recordsData
    
    ' Clear contents of offline sheet
    Sheets("offline").Range("A3").Resize(numOfflineRows, 65).ClearContents
    
    ' Display message box to indicate completion
    MsgBox "Import complete."
End Sub