For loop to copy entire row when match found between two sheets

Question

I am trying to get a For loop which copies an entire row from worksheet 1 to worksheet 3 if the cell in column C in ws1 and column AT in ws2 matches. I have two issues: 1. It seems to be stuck in the For i = xxxxx loop and does not move to the next k (only copies one line 25 times) 2. When I use it on a sheet that has 100,000 rows for worksheet 1 and 15,000 rows on worksheet 2, excel just crashes. Is there a way to manage this?

Sub CopyBetweenWorksheets()
Application.ScreenUpdating = False

Dim i As Long, k As Long, ws1 As Worksheet, ws2 As Worksheet, myVar As String, myVar2 As String
Set ws1 = Worksheets("BOM")
Set ws2 = Worksheets("APT")
Set ws3 = Worksheets("Combined")

'get the last row for w2 and w1
ii = ws1.Cells.SpecialCells(xlCellTypeLastCell).row
kk = ws2.Cells.SpecialCells(xlCellTypeLastCell).row

For k = 2 To kk
    myVar = ws2.Cells(k, 46)
For i = 688 To ii   '688 To ii
    myVar2 = ws1.Cells(i, 3)
    If myVar2 = myVar Then
        ws3.Rows(k).EntireRow.Value = ws1.Rows(i).EntireRow.Value 'copy entire row
      Exit For
       End If
    Next i
Next k

End Sub

Answer 1

Your code is fine (not mentioning the missing Application.ScreenUpdating = True ), but it will hang on large number of rows and columns because of the amount of interations with the application (Excel in this case).

Each time you request a value from a single cell from Excel, your code will hang for about 4 secounds per 1 million requests. From an entire row it will hang for 4 secounds per 4000 requests. If you try writing a single cell, your code will hang for 4 secounds per 175000 requests, and writing an entire row will hang your code for 4 secounds per 300 requests.

This way, only if you try parsing 15.000 rows of data from one sheet to another, your code will hang for about 3,3 minutes.. not to mention all read requests..

So, always keep the amount of interactions with any application from vba to a minimum, even if you have to create a much bigger code.

Here is what your code should look like if you want to handle a lot of data:

Sub CopyBetweenWorksheets2()
Dim aAPT, aBOM, aCombined As Variant
Dim lLastRow As Long, lLastColumn As Long
Dim i As Long, j As Long

Const APTColRef = 3
Const BOMColRef = 46
Const MAXCol = 200

'Speed up VBA in Excel
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

'Get the last row and column to use with the combined sheet
lLastRow = WorksheetFunction.Min(APT.Cells.SpecialCells(xlCellTypeLastCell).Row, BOM.Cells.SpecialCells(xlCellTypeLastCell).Row)
lLastColumn = WorksheetFunction.Min(MAXCol, WorksheetFunction.Max(APT.Cells.SpecialCells(xlCellTypeLastCell).Column, BOM.Cells.SpecialCells(xlCellTypeLastCell).Column))

'Parse all values to an array, reducing interactions with the application
aAPT = Range(APT.Cells(1), APT.Cells(lLastRow, lLastColumn))
aBOM = Range(BOM.Cells(1), BOM.Cells(lLastRow, lLastColumn))

'Creates a temporary array with the values to parse to the destination sheet
ReDim aCombined(1 To lLastRow, 1 To lLastColumn)

'Loop trough values and parse the row value if true
For i = 1 To lLastRow
If aAPT(i, APTColRef) = aBOM(i, BOMColRef) Then
    For j = 1 To lLastColumn
        aCombined(i, j) = aAPT(i, j)
    Next
End If
Next

'Parse values from the destination array to the combined sheet
Combined.Range(Combined.Cells(1), Combined.Cells(lLastRow, lLastColumn)) = aCombined

'Disable tweaks
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationManual
End Sub

!! I named the sheets objects in the VBA itself, so you don't have to declare a new variable and you also won't have any problems if you rename them later. So, insted of sheets("APT"), I just used APT (you will have to rename it too if you want the code to work) !!

Plus, here is my speed code I wrote for speed testing my codes. I always keep it at hand, and use it in almost every function i write

Sub Speed()
Dim i As Long
Dim dSec As Double
Dim Timer0#
Dim TimerS#
Dim TimerA#
Dim TimerB#

dSec = 4 ''Target time in secounds''
i = 1
WP1:
Timer0 = Timer
For n = 1 To i
SpeedTestA
Next
TimerA = Timer
For n = 1 To i
SpeedTestB
Next
TimerB = Timer

If TimerB - Timer0 < dSec Then
    If TimerB - Timer0 <> 0 Then
        i = CLng(i * (dSec * 2 / (TimerB - Timer0)))
        GoTo WP1
    Else
        i = i * 100
        GoTo WP1
    End If
End If
MsgBox "Código A: " & TimerA - Timer0 & vbNewLine & "Código B: " & TimerB - TimerA & vbNewLine & "Iterações: " & i
End Sub

Sub SpeedTestA() 'Fist Code

End Sub

Sub SpeedTestB() 'Secound Code

End Sub