Quantcast
Channel: Macro that does some kind of duplicate check - Code Review Stack Exchange
Viewing all articles
Browse latest Browse all 4

Macro that does some kind of duplicate check

$
0
0

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 WorkbookDim Wb2 As WorkbookWith Application.ScreenUpdating = False.EnableEvents = False.DisplayAlerts = FalseEnd WithSet Wb1 = Workbooks.Open("")Set Wb2 = Workbooks.Open("")Wb1.Sheets("CDGL Data").Copy After:=Wb2.Sheets("STS")Wb1.Close FalseWith Application.ScreenUpdating = True.EnableEvents = True.DisplayAlerts = TrueEnd WithSheets("CDGL Data").SelectRange("AQ:BB").EntireColumn.DeleteRange("A1").AutoFilter Field:=32, Criteria1:=Sheets("DataSources").Range("B4").ValueActiveSheet.UsedRange.Offset(1, 0).SpecialCells _(xlCellTypeVisible).CopySheets("CDGL").SelectRange("B2").PasteSpecial Paste:=xlPasteValuesWith Sheets("CDGL")rows_c1 = .Cells(Rows.Count, "G").End(xlUp).RowSheets("Duplicate Check").Range("A1:C"& rows_c1).Value = Sheets("CDGL").Range("H2:J"& rows_c1).Valuerows_c2 = .Cells(Rows.Count, "K").End(xlUp).RowSheets("Duplicate Check").Range("D1:G"& rows_c2).Value = Sheets("CDGL").Range("L2:O"& rows_c2).Valuerows_c3 = .Cells(Rows.Count, "AI").End(xlUp).RowSheets("Duplicate Check").Range("H1:H"& rows_c3).Value = Sheets("CDGL").Range("AJ2:AJ"& rows_c3).ValueEnd WithSheets("Duplicate Check").SelectSet rng = Range("A1", Range("H1").End(xlDown))rng.RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8), Header:=xlNoWith 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("Duplicate Check").Range("H1:H"& .Cells(.Rows.Count, "A").End(xlUp).Row).ValueEnd WithApplication.DisplayAlerts = FalseSheets("Duplicate Check").DeleteActiveWorkbook.SaveAs Filename:=""ActiveWorkbook.CloseEnd Sub

Viewing all articles
Browse latest Browse all 4

Latest Images

Trending Articles





Latest Images