8
\$\begingroup\$

I am running this code as a macro in Excel, which copies two columns from sheet 1 and pastes them into sheet two. It then compares the first column to a column in sheet two before deleting any duplicates. The two columns I am copying are product code and price. I need to compare the product code to the existing ones.

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

With Sheets("Sheet2")
.Range("M:M").ClearContents
.Range("S:S").ClearContents

Sheets("Sheet1").Range("C:C").Copy
Sheets("Sheet2").Range("M1").Select
ActiveSheet.Paste


Sheets("Sheet1").Range("X:X").Copy
Sheets("Sheet2").Range("S1").Select
ActiveSheet.Paste

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

' 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
            .Cells(iCtr, "S").Delete shift:=xlUp
        End If
    Next iCtr
  End With

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.

\$\endgroup\$
2
  • \$\begingroup\$ Do you want existing product codes to be replaced by the new ones or just not copy the ones that already exist? \$\endgroup\$ Jul 29, 2015 at 16:01
  • \$\begingroup\$ I just want to not copy the new ones that exist \$\endgroup\$ Jul 30, 2015 at 7:58

5 Answers 5

10
\$\begingroup\$
  • It's poor form to have this much logic in an event procedure. The first step is to move 99% of this code into another module and call it from the event procedure.
  • Don't activate and select. This slows down your code and makes it bug prone. Use a variable to reference the worksheets and ranges you need instead.
  • There's no reason to select and paste. The Copy method takes an optional Destination parameter.

    Instead of this

    Sheets("Sheet1").Range("C:C").Copy
    Sheets("Sheet2").Range("M1").Select
    ActiveSheet.Paste
    

    Use this

    Sheets("Sheet1").Range("C:C").Copy Sheets("Sheet1").Range("M1")
    
  • Anytime you turn sheet calculation or screen updating off, you need to use an error handler to make sure it always gets turned back on.

  • Look into using an ADODB connection to query the workbook instead of working directly with the COM object. It's typically a much, much faster approach.
\$\endgroup\$
8
\$\begingroup\$

I agree with what the other reviewers have said but thought I would add this suggestion to see how it is received.

How do people feel about using the intrinsic Excel functions for a task such as this one?

You could follow these steps:

  1. Copy/assign the values from columns C and X onto a temp sheet.
  2. Add the MATCH function in column C on the temp sheet to identify those product codes that already exist in the "Master" data.
  3. Apply a Filter to only show the not-matched values.
  4. Copy the product code and price to columns M and S.
  5. Clear the values from the temp sheet.

The obvious downside of this is that your VBA code is not as readable because you need to figure out the MATCH function but I would imagine it runs faster than looping through 30,000 items of data.

\$\endgroup\$
1
  • \$\begingroup\$ My favorite VBA answers are the ones that say "Don't use it at all." ++ \$\endgroup\$
    – RubberDuck
    Jul 29, 2015 at 22:58
7
\$\begingroup\$

Not used variables

You don't use i, x, or counter, so you can remove them.

Naming

Your variables names should tell the reader about itself. v doesn't tell me anything about what the variable is or its purpose.

Indentation

Your indentation is somewhat sporadic. You should indent one level for each loop, if, function, etc., which will help improve readability, which helps prevent bugs.

I'm not an expert on VBA or Excel, so I'll leave everything else to the experts. I just learned what I know by working on the Rubberduck VBE addin.

\$\endgroup\$
1
  • \$\begingroup\$ That indentation format isn't C# specific. It can (and should) be applied to most languages. \$\endgroup\$
    – RubberDuck
    Jul 29, 2015 at 16:16
6
\$\begingroup\$

General stuff in additon to the very correct critique by Hosch:

  1. Use Option Explicit:
    It has been iterated over and over here on CodeReview and all the internet... Search for it and you will find out why that is a good idea

  2. Declare variables as close as possible to their usage:
    The smaller the "scope" of your variable, the less you have to keep in mind about what it is, what it does and how it interacts with other variables

  3. Drop the systemic hungarian:
    It's not necessary anymore for any Programmer to hackt together names with types. iCtr, iListCount should be just ctr and listCount

  4. Error handling: Imagine your code crashes somewhere between:

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    

    and the counterpiece where you turn things on again. Use the clean exit pattern that Mat's Mug and Rubberduck (our two most active vba reviewers) explain over and over:

    On Error Goto CleanExit
    ' code here
    :CleanExit
       Application.ScreenUpdating = True
       Application.Calculation = xlCalculationAutomatic
    Exit Sub
    
\$\endgroup\$
4
\$\begingroup\$

In terms of your goal, it might be easier to do an operation like this -

Sub colm()
    Sheet1.Range("C1", Sheet1.Range("C" & Rows.Count).End(xlUp)).Copy Sheet2.Range("M" & Rows.Count).End(xlUp)(2)
    Sheet1.Range("X1", Sheet1.Range("X" & Rows.Count).End(xlUp)).Copy Sheet2.Range("S" & Rows.Count).End(xlUp)(2)
    Sheet2.Range("M1", Sheet2.Range("M" & Rows.Count).End(xlUp)).EntireRow.RemoveDuplicates 1
End Sub

I don't have 30K lines to experiment with, but there wasn't any difference between 5 and 1000. Maybe give it a try.

\$\endgroup\$

Your Answer

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

Not the answer you're looking for? Browse other questions tagged or ask your own question.