Vba copy paste slows with more records - excel

Question

I'm trying to help someone who has to go through 80k rows on excel between two sheets and identify differences and then load the changed records into a database.
The below code works but slows down significantly with bigger data set, at 10k rows it takes 00:02:22 but with 20k it takes 00:10:13, full 80k rows takes under 2 hours which is still a lot faster than someone doing it manually over a day but I hoping someone can tell me what can potentially be impacting the performance with a higher number of records and how I can solve it?
Sub Button1_Click()
'Option Explicit
Application.ScreenUpdating = False
Application.EnableEvents = False
Set Day1_Sheet = ThisWorkbook.Sheets("Day1")
Set Day2_Sheet = ThisWorkbook.Sheets("Day2")
Set VBA_Export = ThisWorkbook.Sheets("VBA_Export")
Dim Day1Code, Day2Code As String
Dim Day1CodeRow As Long, Day2CodeRow As Long, CurrentRow As Long, CurrentColumn As Long, AccountsN As Long, n As Long
Dim LastEmptyColumnResult As Long, LastEmptyRowResult As Long
Dim BolUpdated As Boolean
Dim cTime, eTime As Variant
Day1_Sheet_Rows = Day1_Sheet.Cells(Rows.Count, "B").End(xlUp).Row
Day2_Sheet_Rows = Day2_Sheet.Cells(Rows.Count, "B").End(xlUp).Row
LastEmptyColumnResult = 4
LastEmptyRowResult = 2
BolUpdated = False
VBA_Export.Range("A2:E10000").Clear
cTime = Now()
For Each c In Day1_Sheet.Range("B2:B" & Day1_Sheet_Rows)
BolUpdated = False
Day1Code = c
For Each e In Day2_Sheet.Range("B2:B" & Day2_Sheet_Rows)
If c = e Then
Day2Code = e
Day2CodeRow = e.Row
CurrentRow = c.Row
Exit For
End If
Next e
CurrentColumn = 3
While CurrentColumn <> 17
If Day1_Sheet.Cells(CurrentRow, CurrentColumn).Value = Day2_Sheet.Cells(Day2CodeRow, CurrentColumn).Value Then
Else
If BolUpdated Then
Else
Day2_Sheet.Rows(Day2CodeRow).EntireRow.Copy VBA_Export.Range("A" & LastEmptyRowResult)
LastEmptyRowResult = LastEmptyRowResult + 1
BolUpdated = True
End If
End If
CurrentColumn = CurrentColumn + 1
Wend
Next c
LastLine:
Set Day1_Sheet = Nothing
Set Day2_Sheet = Nothing
eTime = Now()
MsgBox ("Start Time " & cTime & ".End Time " & eTime)
Debug.Print "Elapsed Time " & eTime - cTime
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

Answer 1

See below for suggestions for speeding up your process - basically do everything you can using arrays and avoid cell-by-cell access.
Sub Button1_Click()
Const NUM_COLS As Long = 16 'number of columns in your datasets
Dim Day1_Sheet As Worksheet, Day2_Sheet As Worksheet, VBA_Export As Worksheet
Dim data1, data2, destRow As Long, changed As Boolean, rw1 As Long, rw2 As Variant
Dim col As Long, cTime, eTime
Set Day1_Sheet = ThisWorkbook.Sheets("Day1")
Set Day2_Sheet = ThisWorkbook.Sheets("Day2")
Set VBA_Export = ThisWorkbook.Sheets("VBA_Export")
'load both datasets into arrays for faster access
data1 = Day1_Sheet.Range("A1").Resize(Day1_Sheet.Cells(Rows.Count, "B").End(xlUp).Row, NUM_COLS).Value
data2 = Day2_Sheet.Range("A1").Resize(Day2_Sheet.Cells(Rows.Count, "B").End(xlUp).Row, NUM_COLS).Value
VBA_Export.Range("A2:E10000").Clear
destRow = 2
cTime = Now()
GoFast 'turn on speed enhancements
For rw1 = 2 To UBound(data1, 1) 'loop over Day1 data
'try to match on colB - using Match on the worksheet is quite fast
rw2 = Application.Match(data1(rw1, 2), Day2_Sheet.Columns("B"), 0) 'find matching row...
If Not IsError(rw2) Then 'got a match on Day2 ?
changed = False 'reset flag
For col = 3 To NUM_COLS 'loop over columns
If data1(rw1, col) <> data2(rw2, col) Then
changed = True 'flag row as changed
Exit For 'no need to check further
End If
Next col
If changed Then 'Day2 is different?
Day2_Sheet.Rows(rw2).Copy VBA_Export.Cells(destRow, "A")
destRow = destRow + 1 'next paste row
End If
Else
'no Col B match was found. Do something?
End If
Next rw1
GoFast False 'turn off speed enhancements
eTime = Now()
MsgBox ("Start Time " & cTime & ".End Time " & eTime)
Debug.Print "Elapsed Time " & eTime - cTime
End Sub
'maximize code speed by turning off unneeded stuff
'******** must reset !!!!
Sub GoFast(Optional bYesNo As Boolean = True)
With Application
.ScreenUpdating = Not bYesNo
.Calculation = IIf(bYesNo, xlCalculationManual, xlCalculationAutomatic)
End With
End Sub