HiveBrain v1.2.0
Get Started
← Back to all entries
patternModerate

Macro that does some kind of duplicate check

Submitted by: @import:stackexchange-codereview··
0
Viewed 0 times
duplicatekindthatsomemacrodoescheck

Problem

This macro pulls in two workbooks, one being a template with saved formulas already, and the other containing data with thousands of rows...I need to increase the speed because the process takes more than 15 minutes.

```
Sub WbtoWb4()

Dim Wb1 As Workbook
Dim Wb2 As Workbook

With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
End With
Set Wb1 = Workbooks.Open("")
Set Wb2 = Workbooks.Open("")

Wb1.Sheets("CDGL Data").Copy After:=Wb2.Sheets("STS")
Wb1.Close False

With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
End With

Sheets("CDGL Data").Select
Range("AQ:BB").EntireColumn.Delete

Range("A1").AutoFilter Field:=32, Criteria1:=Sheets("DataSources").Range("B4").Value
ActiveSheet.UsedRange.Offset(1, 0).SpecialCells _
(xlCellTypeVisible).Copy

Sheets("CDGL").Select
Range("B2").PasteSpecial Paste:=xlPasteValues

With Sheets("CDGL")
rows_c1 = .Cells(Rows.Count, "G").End(xlUp).Row
Sheets("Duplicate Check").Range("A1:C" & rows_c1).Value = Sheets("CDGL").Range("H2:J" & rows_c1).Value

rows_c2 = .Cells(Rows.Count, "K").End(xlUp).Row
Sheets("Duplicate Check").Range("D1:G" & rows_c2).Value = Sheets("CDGL").Range("L2:O" & rows_c2).Value

rows_c3 = .Cells(Rows.Count, "AI").End(xlUp).Row
Sheets("Duplicate Check").Range("H1:H" & rows_c3).Value = Sheets("CDGL").Range("AJ2:AJ" & rows_c3).Value
End With

Sheets("Duplicate Check").Select
Set rng = Range("A1", Range("H1").End(xlDown))
rng.RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8), Header:=xlNo

With Sheets("CDGL")
Sheets("Rec").Range("B6").Resize(.Cells(.Rows.Count, "G").End(xlUp).Row - 1, 3).Value = Sheets("Duplicate Check").Range("A1:C" & .Cells(.Rows.Count, "A").End(xlUp).Row).Value
Sheets("Rec").Range("E6").Resize(.Cells(.Rows.Count, "D").End(xlUp).Row - 1, 4).Value = Sheets("Duplicate Check").Range("D1:G" & .Cells(.Rows.Count, "A").End(xlUp).Row).Value
Sheets("Rec").Range("I6").Resize(.Cells(.Rows.Count, "H").End(xlUp).Row - 1, 1).Value = Sheets("

Solution

Lowest-Hanging VBA Performance Fruit

You have

With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
End With


But you only have it in force for part of your Sub. If you move this

With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
End With


To the very end of your Sub, you should instantly see a big improvement.

In addition, you should set Application.Calculate to xlCalculationManual at the start, and set it back to xlCalculationAutomatic at the end. That's the other big performance drain.

Always Reset anything you disable

Whenever you change an Application.Thing setting, that change will persist as long as Excel remains open. This:

Application.DisplayAlerts = False


is never set back to True. Once your Sub ends, if your user accidentally clicks the close button, Excel will close without prompting them to save their work first. Because alerts are disabled.

Code Snippets

With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
End With
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
End With
Application.DisplayAlerts = False

Context

StackExchange Code Review Q#132520, answer score: 15

Revisions (0)

No revisions yet.