Making VBA-Excel code more Efficient - vba

Question

I am running this vba code in Excel, it copies a columns from sheet 1, pastes it into sheet two. It then compares it to a column in sheet two before deleting any duplicates.
Private Sub CommandButton1_Click()
Dim MasterList As New Dictionary
Dim iListCount As Integer
Dim x As Variant
Dim iCtr As Integer
Dim v As Variant
Dim counter As Integer, i As Integer
counter = 0
Sheets("Sheet2").Select
Sheets("Sheet2").Range("M:M").Select
Selection.ClearContents
Sheets("Sheet1").Select
Sheets("Sheet1").Range("C:C").Select
Selection.Copy
Sheets("Sheet2").Select
Sheets("Sheet2").Range("M1").Select
ActiveSheet.Paste
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
' Get count of records in master list
iListCount = Sheets("sheet2").Cells(Rows.Count, "A").End(xlUp).Row
'Load Dictionary:
For iCtr = 1 To iListCount
v = Sheets("sheet2").Cells(iCtr, "A").value
If Not MasterList.Exists(v) Then MasterList.Add v, ""
Next iCtr
'Get count of records in list to be deleted
iListCount = Sheets("sheet2").Cells(Rows.Count, "M").End(xlUp).Row
'Loop through the "delete" list.
For iCtr = iListCount To 1 Step -1
If MasterList.Exists(Sheets("Sheet2").Cells(iCtr, "M").value) Then
Sheets("Sheet2").Cells(iCtr, "M").Delete shift:=xlUp
End If
Next iCtr
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox "Done!"
End Sub
There is just under 30,000 rows that it has to compare so I know that it is always going to take some time, but I was wondering if there was any way to speed it up or even just make my code more streamline and efficient.

Answer 1

Don't copy and paste from sheet 1 to sheet 2. Store the values from both sheets in arrays:
Dim v1 as variant, v2 as variant
v1 = Sheet1.Range("C:C").Value
v2 = Sheet2.Range("A1").Resize(iListCount,1).Value
Then read the values in v1 into a dictionary, loop through the values in v2 and check if each of them exists in the dictionary or not. If they exist, remove the item from the dictionary.

Answer 2

This will make it a bit more efficient
Dim MasterList As New Dictionary
Dim iListCount As Integer
Dim x As Variant
Dim iCtr As Integer
Dim v As Variant
Dim counter As Integer, i As Integer
counter = 0
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
With Sheets("Sheet2")
.Range("M:M").ClearContents
Sheets("Sheet1").Range("C:C").Copy
.Range("M1").Paste
' Get count of records in master list
iListCount = .Cells(Rows.Count, "A").End(xlUp).Row
'Load Dictionary:
For iCtr = 1 To iListCount
v = .Cells(iCtr, "A").Value
If Not MasterList.Exists(v) Then MasterList.Add v, ""
Next iCtr
'Get count of records in list to be deleted
iListCount = .Cells(Rows.Count, "M").End(xlUp).Row
' Loop through the "delete" list.
For iCtr = iListCount To 1 Step -1
If MasterList.Exists(.Cells(iCtr, "M").Value) Then
.Cells(iCtr, "M").Delete shift:=xlUp
End If
Next iCtr
End With
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox "Done!"
If you really wanted to make it more effceint I would change below
' Loop through the "delete" list.
For iCtr = iListCount To 1 Step -1
If MasterList.Exists(.Cells(iCtr, "M").Value) Then
.Cells(iCtr, "M").Delete shift:=xlUp
End If
Next iCtr
So that you miss the sheet. e.g. delete them out of the dictionary and then clear the list and then output the dictionary in one line of code. Accessing the sheet is the costly part in terms of CPU use, limit how many times you access the sheet for much much faster code. you could also try to remove the loop for reading entries in and try and do that in one line of code too
Slow parts to consider
.Cells(iCtr, "A").Value
and probably causing most of the time below
.Cells(iCtr, "M").Delete shift:=xlUp

Answer 3

Here is my version of optimized code.
Comments about the concepts used are put in the code.
Private Sub CommandButton1_Click()
Dim MasterList As New Dictionary
Dim data As Variant
Dim dataSize As Long
Dim lastRow As Long
Dim row As Long
Dim value As Variant
Dim comparisonData As Variant
Dim finalResult() As Variant
Dim itemsAdded As Long
'-----------------------------------------------------------------
'First load data from column C of [Sheet1] into array (processing
'data from array is much more faster than processing data
'directly from worksheets).
'Also, there is no point to paste the data to column M of Sheet2 right now
'and then remove some of them. We will first remove unnecessary items
'and then paste the final set of data into column M of [Sheet2].
'It will reduce time because we can skip deleting rows and this operation
'was the most time consuming in your original code.
With Sheets("Sheet1")
lastRow = .Range("C" & .Rows.Count).End(xlUp).row
data = .Range("C1:C" & lastRow)
End With
'We can leave this but we don't gain much with it right now,
'since all the operations will be calculated in VBA memory.
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'We make the same operation to load data from column A of Sheet2
'into another array - [comparisonData].
'It can seem as wasting time - first load into array instead
'of directly iterating through data, but in fact it will allow us
'to save a lot of time - since iterating through array is much more
'faster than through Excel range.
With Sheets("Sheet2")
lastRow = .Range("A" & .Rows.Count).End(xlUp).row
comparisonData = .Range("A1:A" & lastRow)
End With
'Iterate through all the items in array [comparisonData] and load them
'into dictionary.
For row = LBound(comparisonData, 1) To UBound(comparisonData, 1)
value = comparisonData(row, 1)
If Not MasterList.Exists(value) Then
Call MasterList.Add(value, "")
End If
Next row
'Change the size of [finalResult] array to make the place for all items
'assuming no data will be removed. It will save some time because we
'won't need to redim array with each iteration.
'Some items of this array will remain empty, but it doesn't matter
'since we only want to paste it into worksheet.
'We create 2-dimensional array to avoid transposing later and save
'even some more time.
dataSize = UBound(data, 1) - LBound(data, 1)
ReDim finalResult(1 To dataSize, 1 To 1)
'Now iterate through all the items in array [data] and compare them
'to dictionary [MasterList]. All the items that are found in
'[MasterDict] are added to finalResult array.
For row = LBound(data, 1) To UBound(data, 1)
value = data(row, 1)
If MasterList.Exists(value) Then
itemsAdded = itemsAdded + 1
finalResult(itemsAdded, 1) = value
End If
Next row
'Now the finalResult array is ready and we can print it into worksheet:
Dim rng As Range
With Sheets("Sheet2")
Call .Range("M:M").ClearContents
.Range("M1").Resize(dataSize, 1) = finalResult
End With
'Restore previous settings.
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox "Done!"
End Sub