I have 2 sheets with the exact format, 5 columns (Category1, Category2, Category3, Month, Amount) - "Temp" and "Source".
My goal is to copy the data from "Source" to a new sheet("Combined"), append the data from "Temp" but replace the rows that are matching on column C and D with the new rows from "Temp".
For now I have the following code that does the job:
Option Explicit
Sub Verify()
Dim c As Range
Application.ScreenUpdating = False
last3 = Sheets("Temp").Cells(Application.Rows.count, "A").End(xlUp).row
last4 = Sheets("Source").Cells(Application.Rows.count, "A").End(xlUp).row
last5 = Sheets("Combined").Cells(Application.Rows.count, "A").End(xlUp).row
' Clear Contents
Sheets("Combined").Range("A1:E" & last5).ClearContents
Sheets("Temp").Range("G2").Formula = "=C2&D2"
Sheets("Temp").Range("G2").Copy Destination:=Sheets("Temp").Range("G3:G" & last3)
Sheets("Source").Range("G2").Formula = "=C2&D2"
Sheets("Source").Range("G2").Copy Destination:=Sheets("Source").Range("G3:G" & last4)
Sheets("Source").Range("H2").Formula = "=MATCH(G2,Temp!$G2ドル:$G$" & last3 & ",0)"
Sheets("Source").Range("H2").Copy Destination:=Sheets("Source").Range("H3:H" & last4)
' Copy & Format Headers
Sheets("Temp").Range("A1:E1").Copy Destination:=Sheets("Combined").Range("A1")
' Copy All Data from Temp
Sheets("Temp").Range("A2:E" & last3).Copy Destination:=Sheets("Combined").Range("A2")
' Copy Selected Data from Source
For Each c In Sheets("Source").Range("H2:H" & last4)
If IsError(c) Then
last5 = Sheets("Combined").Cells(Application.Rows.count, "A").End(xlUp).row
Sheets("Source").Range("A" & c.row & ":E" & c.row).Copy Destination:=Sheets("Combined").Range("A" & last5 + 1)
End If
Next c
' Clean temp Columns
Sheets("Temp").Columns("G:G").Delete
Sheets("Source").Columns("G:H").Delete
Application.ScreenUpdating = True
End Sub
My problem with it is that is too slow(~15.000 rows). It freezes my excel with a white screen for a few minutes but in the end it works. I have tried using DoEvents but it is still really slow.
I am sure there a better way to achieve what I am looking for. Can someone please help me rewrite the VBA to speed it up? I would be grateful if I could at least get it not to freeze or increase the performance somehow.
1 Answer 1
If no one offered a suggestion, I have found a way to handle this. This makes it blazing fast:
Sub Verify()
Dim c As Range, last3 As Long, last4 As Long, last5 As Long
Dim wt As Worksheet, ws As Worksheet, wc As Worksheet
Set wt = Sheets("Temp"): Set ws = Sheets("Source"): Set wc = Sheets("Combined")
Application.ScreenUpdating = False
last3 = wt.Cells(Rows.Count, 1).End(xlUp).Row
last4 = ws.Cells(Rows.Count, 1).End(xlUp).Row
last5 = wc.Cells(Rows.Count, 1).End(xlUp).Row
wc.Cells.ClearContents ' Clear Contents
wt.Range("G2").Resize(last3 - 1, 1).Formula = "=C2&D2"
ws.Range("G2").Resize(last4 - 1, 1).Formula = "=C2&D2"
ws.Range("H2").Resize(last4 - 1, 1).Formula = "=MATCH(G2,Temp!$G2ドル:$G$" & last3 & ",0)"
' Copy & Format Headers
wt.Range("A1:E1").Copy wc.Range("A1")
' Copy All Data from Temp
wt.Range("A2:E" & last3).Copy wc.Range("A2")
' Copy Selected Data from Source
For Each c In ws.Range("H2:H" & last4)
If IsError(c) Then
last5 = wc.Cells(Rows.Count, 1).End(xlUp).Row
wc.Range("A" & last5 + 1).Resize(1, 5).Value = ws.Range("A" & c.Row).Resize(1, 5).Value
End If
Next c
' Clean temp Columns
Application.DisplayAlerts = False: wt.Columns("G").Delete: ws.Columns("G:H").Delete
Application.DisplayAlerts = True: Application.ScreenUpdating = True
End Sub