the 2nd pic is the source sheet in sheet2 it will find the "race" row with the same value in the 1st pic sheet1 then update each column when found, as you can see it has different column structure, what could be the fastest way it could update the destination sheet when it has thousands of rows to loop?

destination - sheet1

source- sheet2

desired result - sheet1

CodePudding user response：

Update Data

Sub UpdateData()

    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Read source.
    
    Dim sws As Worksheet: Set sws = wb.Sheets("Sheet2")
    
    Dim shrg As Range, sData(), shData(), srCount As Long, scCount As Long
    
    With sws.UsedRange
        srCount = .Rows.Count - 1
        scCount = .Columns.Count
        Set shrg = .Resize(1)
        shData = shrg.Value
        sData = .Resize(srCount).Offset(1).Value
    End With
    
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare
    
    Dim sr As Long, sString As String
    
    For sr = 1 To srCount
        sString = CStr(sData(sr, 1))
        If Len(sString) > 0 Then
            dict(sString) = sr
        End If
    Next sr
    
    ' Read destination.
    
    Dim dws As Worksheet: Set dws = wb.Sheets("Sheet1")

    Dim drg As Range, dhrg As Range, dData(), drCount As Long
    
    With dws.UsedRange
        drCount = .Rows.Count - 1
        Set dhrg = .Resize(1)
        Set drg = .Resize(drCount).Offset(1)
        dData = drg.Value
    End With
    
    Dim dcIndices(): dcIndices = Application.Match(shrg, dhrg, 0)
    
    ' Update.
    
    Dim sc As Long, dr As Long, dc As Long, dString As String
    
    For dr = 1 To drCount
        dString = CStr(dData(dr, 1))
        If dict.Exists(dString) Then
            sr = dict(dString)
            For sc = 2 To scCount
                dc = dcIndices(sc)
                dData(dr, dc) = sData(sr, sc)
            Next sc
        End If
    Next dr

    ' Write.

    drg.Value = dData

    ' Inform.

    MsgBox "Data updated.", vbInformation

End Sub

CodePudding user response：

Please, try the next way. It is able to match columns even if their order will differ in the future. It should be very fast, using arrays and processing being done mostly in memory:

Sub UpdateSheet1DiffColsOrder()
   Dim sh1 As Worksheet, sh2 As Worksheet, lastR As Long, lastCol As Long
   Dim arr1, arrH1, arr2, arrH2, arrMtch, i As Long, j As Long
   
   Set sh1 = ActiveSheet 'Workshets("Sheet1")
   Set sh2 = sh1.Next  'Workshets("Sheet2")
   
   lastCol = sh1.cells(1, sh1.Columns.count).End(xlToLeft).column
   
   With Application
        arrH1 = sh1.Range(sh1.cells(1, 1), sh1.cells(1, lastCol)).Value 'place the header from Sheet1 in an array
        
        lastCol = sh2.cells(1, sh2.Columns.count).End(xlToLeft).column 'calculate last column in Sheet2
        arrH2 = sh2.Range(sh2.cells(1, 1), sh2.cells(1, lastCol)).Value 'place the header from Sheet2 in an array
        
        arrMtch = .IfError(.match(arrH2, arrH1, 0), 0)  'match the two header arrays replacing with 0 the not matching cases
   End With
   
   lastR = sh1.Range("A" & sh1.rows.count).End(xlUp).row
   arr1 = sh1.Range("A2:L" & lastR).Value 'place the range to be processed in an array, for faster iteration/processing
   
   arr2 = sh2.Range("A2:G2").Value 'place the range where from to extract data in an array
   
   For i = 1 To UBound(arr1)                          'iterate between the array row
        If arr1(i, 1) = arr2(1, 1) Then               'if a match in their first column
            For j = 1 To UBound(arrMtch)              'iterate between the matching array elements
                If arrMtch(j) <> 0 Then               'if a match has been found
                    arr1(i, arrMtch(j)) = arr2(1, j)  'extract the value in the matched column
                End If
            Next j
        End If
   Next i
   
   'Drop back the processed array at once:
   sh1.Range("A2").Resize(UBound(arr1), UBound(arr1, 2)).Value = arr1
End Sub

Please, send some feedback after testing it.