4
\$\begingroup\$

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.

asked Aug 1, 2017 at 20:06
\$\endgroup\$

1 Answer 1

3
\$\begingroup\$

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
answered Aug 3, 2017 at 17:30
\$\endgroup\$

Your Answer

Draft saved
Draft discarded

Sign up or log in

Sign up using Google
Sign up using Email and Password

Post as a guest

Required, but never shown

Post as a guest

Required, but never shown

By clicking "Post Your Answer", you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.