VBA to copy update data one on sheet and paste into data table on another sheet

Cosworth

New Member
Joined
Oct 17, 2022
Messages
1
Office Version
  1. 365
Platform
  1. Windows
I'm new to the board as a user and pretty darn new to VBA so I apologize in advance for my lack of knowledge. I have a large table (not range) on sheet one. The table has fifteen columns and currently is at 65,000 records. The first column is a fifteen digit unique ID. We've just been told that I will periodically have to update many of the records, but the updates are not sequential so I can't just do a batch (1 - 10, for example). It might be record 1, 17, 19, 22, etc.

On a second worksheet in the same workbook I have a range where I paste the record numbers that I have to update. The range (not a named range) has the same column headers as the table on sheet one. I paste the record numbers in the left column. I make the updates to the data in the relevant columns in that location on the spreadsheet. To the right of that column is a "record duplicator" section which uses XLOOKUP to retrieve all the data on the relevant record and either use the values from the table on sheet 1 or replace it with the updated information. So, if I've update the values in columns 2, 3, and 7 then it uses those bits of info instead of what was in the original data. Other than those three columns the values from the data table are shown.

Using CELL and ADDRESS (I know I can do that in VBA and should/will) I've specified the cell address that needs to be updated with the new info at the left of the record duplicator range. I can then copy the information in the "record duplicator" section to the main data table on sheet one. BUT it has to go to each record individually and not be a general copy/paste.

I have a little bit of code that allows me to loop through the record duplicator range and continue to copy the data until it reaches the last line with data in it, but I'm sorely lacking when it comes to pasting that into the original data table in the correct row. My struggles have to do with using the cell address as the destination for the paste function. I know I can use FIND (or the location specified by my CELL & ADDRESS function, but since that changes for each row I'm struggling to make that dynamic. I've spent a lot of time looking on the board and elsewhere, but am just not finding what I need. If needed I'll put up some dummy data.
 

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.
There are two ways of doing this:
Loop through the table in your second sheet and
  1. range.find the relevant row in the main table, then paste values over that row. Or:
  2. load the main table in an array, Find the value there and update the row. Then when all done dump the array back to the sheet.
If your update involves only a few rows, then option 1 will do.
If your updates generally are a few hundred rows or so, then option 2. will be much faster, because it only involves one read and one write (which are the slow operations).

The code below is the first method, should work reasonably fast

VBA Code:
Option Explicit

Sub UpdateTable1()
'Uses Range.Find to find each row in turn
'Not very fast when many (hundreds) updates are required

    Dim rFind As Range, r1st As Range, rIDs As Range
    Dim lRi As Long, lC As Long, UB2 As Long
    Dim vIn As Variant, vOut As Variant
    Dim wsDB As Worksheet, wsCor As Worksheet
    Dim sNotFoundMsg As String
    
    Set wsDB = Sheets("Data")           '<<<<<<< Change sheetname to sheet with full data table
    Set wsCor = Sheets("Corrections")   '<<<<<<< Change sheetname to sheet with correction table
    
    'set the search column for the IDs
    Set rIDs = wsDB.Range("A:A")
    
    'Assuming both tables headers start in cell A1
    'Read the correction table into an array for fast processing
    vIn = wsCor.Range("A1").CurrentRegion.Value
    'make output array of one row size
    UB2 = UBound(vIn, 2)
    ReDim vOut(1 To 1, 1 To UB2)
    
    For lRi = 2 To UBound(vIn, 1)
        'go through each row of the correction table (skip header)
        
        'find the next ID
        Set rFind = rIDs.Find(what:=vIn(lRi, 1))
        If rFind Is Nothing Then
            sNotFoundMsg = sNotFoundMsg & "Item " & vIn(lRi, 1) & " in row " & lRi & " not found" & vbCrLf
        Else
            'copy row into output array
            For lC = 1 To UB2
                vOut(1, lC) = vIn(lRi, lC)
            Next lC
            'and write the line in one write operation
            rFind.Resize(1, UB2).Value = vOut
        End If
    Next lRi
    
    'check if items not found
    If Len(sNotFoundMsg) = 0 Then
        sNotFoundMsg = "Table updated"
    End If
    MsgBox sNotFoundMsg
End Sub
 
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,176
Members
453,021
Latest member
Justyna P

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top