What is the fastest way to pull data from one sheet to another using VBA

Question

I have and excel file with 2 tabs, one is 166K rows and the other is 400K rows. Previously we were manually performing vlookups to pull data from the 400k row tab into the 166k row tab. I want to automate this some using VBA but am having issues with speed.

I tried an IF formula but that ran for over 30 minutes before I killed the process

 For i = 2 To Assign.UsedRange.Rows.Count
 For x = 2 To HR.UsedRange.Rows.Count

 If Assign.Cells(i, 1 ) = HR.Cells(x,1) Then
   Assign.Cells(i, 9) = HR.Cells(x, 3)
 
 End If

 Next x
 Next i

and now I'm trying a vlookup for VBA but that also is taking a long time.

 For x = 2 To Assign.UsedRange.Rows.Count

 On Error Resume Next
 Worksheets("Assignments").Cells(x, 9).Value = 
 Application.WorksheetFunction.VLookup(Worksheets("Assignments").Cells(x, 5).Value, 
 Worksheets("Workforce").Range("A:AX"), 5, 0)
 On Error GoTo 0
   
 Next x

any suggestions on how to speed this up? I tried using Access but the files were too big.

Answer 1

I would try with the find method instead of an inner loop. You have just to customize your file references and ranges.

 Sub FindMatches()

    Dim shtOld As Worksheet, shtNew As Worksheet

    Dim oldRow As Integer
    Dim newRow As Integer
    Dim i As Integer, id, f As Range

    i = 1

    Set shtOld = ThisWorkbook.Sheets("Assign")
    Set shtNew = ThisWorkbook.Sheets("HR")
        
    For oldRow = 2 To shtOld.UsedRange.Rows.Count

        id = shtOld.Cells(oldRow, 1)

        Set f = shtNew.Range("A1:A1000").Find(id, , xlValues, xlWhole)
        If Not f Is Nothing Then
            With shtOld.Rows(i)
                .Cells(1).Value = shtOld.Cells(oldRow, 1)

            End With
            i = i + 1
        End If

    Next oldRow

End Sub

Answer 2

A VBA Lookup

• This took roughly 13 seconds on my machine (Windows 10, Office 2019 64bit) for 400k vs 160k of integers.
• An optimized (using arrays and Application.Match applied to the lookup column range) Match version took the same amount of time for 10 times fewer data.
• Since your data probably isn't integers, your feedback is highly appreciated.
• Adjust the values in the constants section.

Option Explicit

Sub VBALookup()

    Const sName As String = "Workforce" ' Source Worksheet Name
    Const slFirst As String = "E2" ' Source Lookup Column First Cell Address
    Const svCol As String = "I" ' Source Value Column
    
    Const dName As String = "Assignments" ' Destination Worksheet Name
    Const dlFirst As String = "E2" ' Destination Lookup First Cell Address
    Const dvCol As String = "I" ' Destination Value Column
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Create references to the Source Ranges.
    Dim sws As Worksheet: Set sws = wb.Worksheets(sName)
    Dim sfCell As Range: Set sfCell = sws.Range(slFirst)
    Dim slrg As Range: Set slrg = RefColumn(sfCell) ' lookup range
    If slrg Is Nothing Then Exit Sub
    Dim svrg As Range: Set svrg = slrg.EntireRow.Columns(svCol) ' read value
    
    ' Create references to the Destination Ranges.
    Dim dws As Worksheet: Set dws = wb.Worksheets(dName)
    Dim dfCell As Range: Set dfCell = dws.Range(dlFirst)
    Dim dlrg As Range: Set dlrg = RefColumn(dfCell) ' lookup value
    If dlrg Is Nothing Then Exit Sub
    Dim dvrg As Range: Set dvrg = dlrg.EntireRow.Columns(dvCol) ' write value

    ' Write the 'INDEX/MATCH' formula to a variable.
    Dim dFormula As String
    dFormula = "=IFERROR(INDEX('" & sName & "'!" & svrg.Address(, 0) _
        & ",MATCH(" & dfCell.Address(0, 0) _
        & ",'" & sName & "'!" & slrg.Address(, 0) & ",0)),"""")"
    
    ' Take a look in the Immediate window ('Ctrl + G')
    'Debug.Print "Source", slrg.Address(, 0), svrg.Address(, 0)
    'Debug.Print "Destination", dlrg.Address(, 0), dvrg.Address(, 0)
    'Debug.Print "Formula", dFormula
    
    ' Write the formula to the Destination Value Range
    ' and convert the formulas to values.
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    dvrg.Formula = dFormula
    dvrg.Value = dvrg.Value
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Creates a reference to the range from the first cell
'               of a range ('rg') through the bottom-most non-empty cell
'               of the range's column.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function RefColumn( _
    ByVal rg As Range) _
As Range
    If rg Is Nothing Then Exit Function
    With rg.Cells(1)
        Dim lCell As Range
        Set lCell = .Resize(.Worksheet.Rows.Count - .Row + 1) _
            .Find("*", , xlFormulas, , , xlPrevious)
        If lCell Is Nothing Then Exit Function
        Set RefColumn = .Resize(lCell.Row - .Row + 1)
    End With
End Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Returns the values of a range ('rg') in a 2D one-based array.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GetRange( _
    ByVal rg As Range) _
As Variant
    If rg Is Nothing Then Exit Function
    Dim rData As Variant
    If rg.Rows.Count + rg.Columns.Count = 2 Then
        ReDim rData(1 To 1, 1 To 1): rData(1, 1) = rg.Value
    Else
        rData = rg.Value
    End If
    GetRange = rData
End Function