Faster way to update/add rows

[ianawwalker]

Hello,
I have vba that updates rows if the record is there and then adds the row if the record isn't there. It works great if there are less than 100 items that the vba needs to review, because it needs to loop through each individual line to see if it needs to update it. Hoping someone can review my code below to see if there is a faster way i can have this vba process this, as currently it takes over 30 min for it to review around 5,000 records and there are times were i need it to review 15,000 to 25,000 records. Appreciate any help! thank you!

OfflineRecordCount = Sheets("Offline").Range("a2").End(xlDown).Row - 3
Application.ScreenUpdating = False

For i = 1 To OfflineRecordCount

Sheets("input_posting").Range("OfflineLoanNum") = Sheets("offline").Range("a3").Offset(i)
offlinerecord = Sheets("input_posting").Range("Offlinematch") - 3

If Sheets("input_posting").Range("offlinematch") > 0 Then

Sheets("offline").Range("a3").Offset(i).EntireRow.Copy
'paste
Sheets("records").Select
ActiveSheet.Range("StartSpot").Offset(offlinerecord).Select
ActiveSheet.Paste
Sheets("offline").Range("a3").Offset(i).EntireRow.ClearContents



Else
'copy
Sheets("offline").Range("a3").Offset(i).EntireRow.Copy
'paste
Sheets("Records").Select
ActiveSheet.Range("a3").Select
ActiveCell.End(xlDown).Offset(1).Select
ActiveSheet.Paste
Sheets("offline").Range("a3").Offset(i).EntireRow.ClearContents

End If
Next i
i = 0
MsgBox ("Import Complete")
'clear conents
Sheets("input_Screen").Select
Range("LoanNum").Select

Application.ScreenUpdating = True

 

[mikenelena]

Hi,

Please take a look at this method using arrays and see if it looks like it might do what you need. This updated code reads the data from the "offline" sheet, the "input_posting" sheet, and the "Records" sheet into arrays. It then creates a dictionary to store the loan numbers from the "input_posting" sheet for quick lookup. The code then loops through the rows of the "offline" data, updates the corresponding row in the "Records" data if a match is found in the dictionary, and adds a new row to the "Records" data if a match is not found. Finally, the updated "Records" data is written back to the sheet, the contents of the "offline" sheet are cleared, and a message box is displayed to indicate completion.

Sub UpdateRecords()
    Dim offlineData As Variant
    Dim postingData As Variant
    Dim recordsData As Variant
    Dim postingDict As Object
    Dim i As Long
    Dim j As Long
    Dim numOfflineRows As Long
    Dim numPostingRows 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(, 10).Value
    postingData = Sheets("input_posting").Range("A2").Resize(, 10).Value
    recordsData = Sheets("Records").Range("StartSpot").Resize(, 10).Value
    
    ' Create a dictionary to store loan numbers from the posting data
    Set postingDict = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(postingData, 1)
        loanNum = postingData(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 10
                recordsData(offlinerecord, j) = offlineData(i, j)
            Next j
        Else
            numRecordsRows = numRecordsRows + 1
            For j = 1 To 10
                recordsData(numRecordsRows, j) = offlineData(i, j)
            Next j
        End If
    Next i
    
    ' Write updated records data to sheet
    Sheets("Records").Range("StartSpot").Resize(numRecordsRows, 10).Value = recordsData
    
    ' Clear contents of offline sheet
    Sheets("offline").Range("A3").Resize(numOfflineRows, 10).ClearContents
    
    ' Display message box to indicate completion
    MsgBox "Import complete."
End Sub

 

[ianawwalker]

Hi Mike, thank you for the help! i am getting an error of run-time error '9' at recordsData(numRecordsRows, j) = offlineData(i, j) and am unsure on how to correct that. do you know why this error would be popping up?

 

[mikenelena]

Just in case the problem is that the size of the array isn't large enough, and doesn't have enough rows to accommodate the date, give this a try. It resizes the array for you. Fingers crossed. Trouble-shooting arrays is not my strongest suit.

Sub UpdateRecords()
    Dim offlineData As Variant
    Dim postingData As Variant
    Dim recordsData As Variant
    Dim postingDict As Object
    Dim i As Long
    Dim j As Long
    Dim numOfflineRows As Long
    Dim numPostingRows 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(, 10).Value
    postingData = Sheets("input_posting").Range("A2").Resize(, 10).Value
    recordsData = Sheets("Records").Range("StartSpot").Resize(, 10).Value
    
    ' Create a dictionary to store loan numbers from the posting data
    Set postingDict = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(postingData, 1)
        loanNum = postingData(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 10
                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 10)
            End If
            For j = 1 To 10
                recordsData(numRecordsRows, j) = offlineData(i, j)
            Next j
        End If
    Next i
    
    ' Write updated records data to sheet
    Sheets("Records").Range("StartSpot").Resize(numRecordsRows, 10).Value = recordsData
    
    ' Clear contents of offline sheet
    Sheets("offline").Range("A3").Resize(numOfflineRows, 10).ClearContents
    
    ' Display message box to indicate completion
    MsgBox "Import complete."
End Sub