1
\$\begingroup\$

I am pretty knew to the VBA world but I am really eager to improve my skills. I have a case where I would like to match cancellation with new business to see what we get back from our dropped business as new orders.

The matching is as follows: a variable called Fastighet (meaning "real estate" in Swedish) will be specified and takes a value from the dropped business and searches in the new orders business. If they match with same real estate then will check the date of new business if it is +/- 90 days then it will bring me back something called "Service-ID". The macros below work and get me the result but it takes 3 hours every time to finish matching as it matches 2200 rows in dropped business with 25000 rows of new orders!

My question is: Is there a way to make it faster?

Sub MatchingNedVSUpp()

Dim LRow, LRow2, i, n, serviceID As Long
Dim Fastighet As String

LRow = Sheet5.Range("A" & Rows.Count).End(xlUp).Row
LRow2 = Sheet6.Range("A" & Rows.Count).End(xlUp).Row


For i = 3 To LRow
    Fastighet = Sheet5.Range("CA" & i).Value
    For n = 3 To LRow2
       serviceID = Sheet6.Range("B" & n).Value

       If Sheet6.Range("BH" & n).Value = Fastighet And Sheet6.Range("AH" & n) <= Sheet5.Range("BM" & i) And Sheet6.Range("AH" & n) >= Sheet5.Range("BL" & i) And Sheet5.Application.WorksheetFunction.CountIf(Range("BU:BU"), serviceID) = 0 Then
           Sheet6.Range("B" & n).Copy
           Sheet5.Range("BU" & i).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                     :=False, Transpose:=False
           Application.CutCopyMode = False
       End If
   Next n
Next i

End Sub
\$\endgroup\$
4
\$\begingroup\$

The line Dim LRow, LRow2, i, n, serviceID As Long isn't doing what you think it is. When you declare multiple variables on the same line, you need to individually assign types to all of them - otherwise the default to Variant. I'm assuming that line was meant to be Dim LRow As Long, LRow2 As Long, i As Long, n As Long, serviceID As Long. You could probably also give them names that have more meaning than i and n.


Kudos on using the code names to refer to your worksheets instead of indexing the Worksheets collection - this is a much more reliable method to access them. However, you are still repeatedly accessing them. I'd wrap the majority of this Sub in With Sheet6. That not only keeps you from repeatedly dereferencing the same thing, it makes it much more clear when you are using Sheet5 by making it stand out more. While you're at it, I'd rename the worksheet code names to something more descriptive. I have no clue what Sheet5 even means beyond that it was the fifth worksheet that was added to the workbook.


This might be a micro-performance thing, but using .Cells() is typically better than using .Range() when you only need one cell. This not only avoids concatenating your cell addresses, but it prevents making Excel convert your alpha columns back to numbers. Finally, it lets you use column constants that are more descriptive than "AH". You can use something like this...

Const FooColumn As Long = 34
'...
Sheet6.Cells(currentRow, FooColumn)

...which is much more readable.


You are using implicit default member calls on the tests Sheet6.Range("AH" & n) <= Sheet5.Range("BM" & i) and Sheet6.Range("AH" & n) >= Sheet5.Range("BL" & i). This appears to be an oversight, in that you're using explicit calls to Value everywhere else.


Performance

DON'T USE COPY AND PASTE FOR VALUES. This is horrendously inefficient. You can assign these directly like so: Sheet5.Range("BU" & i).Value = Sheet6.Range("B" & n).Value. Even better would be to suck all of your source data into an array and use that instead. That cuts down on the round-trips you're making to the worksheet. Ever time you touch a cell, Excel has to at minimum recalculate and redraw. If you can do all of your work in memory, do that, then use the Worksheet simply for "output".


The call to Sheet5.Application.WorksheetFunction.CountIf(Range("BU:BU"), serviceID) is absolutely killing you. First, you're applying it over the entire column (1,048,576 rows) and you're doing it in a nested loop. Finally, If statements are not short-circuited in VBA, so you're always performing this lookup. If the only thing you need to do is find out if the serviceID exists in that column, read all of the values there into a Scripting.Dictionary, and look them up in that instead:

Private Function GetServiceIDLookup() As Scripting.Dictionary
    Dim results As New Scripting.Dictionary
    With Sheet5
        Dim currentRow As Long
        Dim serviceID As Long
        For currentRow = 1 To .Cells(.Rows.Count, LookupTargetColumn).End(xlUp).Row
            serviceID = .Cells(currentRow, LookupTargetColumn).Value
            If Not results.Exists(serviceID) Then results.Add serviceID, serviceID
        Next
    End With
    Set GetServiceIDLookup = results
End Function

Build the lookup, then instead of Sheet5.Application.WorksheetFunction.CountIf(Range("BU:BU"), serviceID) = 0, you would be doing something more like this:

'Outside the loops
Dim serviceIDs As Scripting.Dictionary
Set serviceIDs = GetServiceIDLookup
'...
For i = 3 To LRow
    Fastighet = Sheet5.Cells(i, 79).Value
    For n = 3 To LRow2
        serviceID = Sheet6.Cells(n, 2).Value
        'Dictionary lookup
        If serviceIDs.Exists(serviceID) And WhateverElse Then

Between that change and pulling arrays instead of repeated worksheet accesses, you should be able to reduce the runtime by several orders of magnitude.

\$\endgroup\$
  • \$\begingroup\$ Thanks a lot for your help so much appreciated. I'm trying to do the lookup function but it is stopping on results.add and giving me "Compile error: argument not optional" what I'm doing wrong? if I understood right: you said to build the look up separately and it will be like calling it in the loop, or did you mean within the same codes both will be? \$\endgroup\$ – Sam.H Nov 9 '18 at 9:55
  • \$\begingroup\$ @SamoZain - Sorry, a line got chopped off there - .Add has 2 arguments. See the edit. \$\endgroup\$ – Comintern Nov 9 '18 at 13:08
  • \$\begingroup\$ Thanks for your help, but something wrong I'm doing! The "ServiceID " value is always null and in the second loop is stopping giving me "type mismatch" error? The code that I'm using is below (The New code),I built the function outside the code and called it within the code as below (The New code) \$\endgroup\$ – Sam.H Nov 11 '18 at 16:55

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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