0
\$\begingroup\$

I'm finding names then going to the corresponding column to get the number, then search for the number in column A. If I find the number then go to the corresponding column, copy and paste it to a different worksheet.

How can I make this code faster and more efficient? I found several examples in here, someone suggested to use Variants as well as UBound() and LBound(). I used it but the performance is still the same: It's taking more than 5 mins to loop through 1 million rows.

 Dim wsheet1 as Worksheet, wsheet2 as Worksheet, lastrow as long, correspondingValue1 as Object, correspondingOffset as Object, searchNum as Object, data1, data1Range as Range, x as Long, y as Long

   Set wsheet1 = ActiveWorkbook.Worksheets("Sheet1")
   Set wsheet2 = ActiveWorkbook.Worksheets("Sheet2")
   Set data1Range =  wsheet2.Range(wsheet2.Range("C1"), wsheet2.Cells(Rows.Count, 1).End(xlUp))
   data1 = data1Range.Value


       For i = 1 To UBound(data1, 1)
            If wsheet2.Cells(i, 3).Value = "Mike" Or wsheet2.Cells(i, 3) = "Sam" Or wsheet2.Cells(i, 3) = "George" Or wsheet2.Cells(i, 3) = "Abrahim" Then
              Set correspondingValue1 = wsheet2.Cells(i, 3)
              Set correspondingOffset = corespondingValue1.Offset(columnoffset:=7)

                If InStr(1, xoffset, "1.") <> 0 Then
                    With wsheet2.Range("a1:a" & lastrow)
                    Set searchNum = .Find(wsheet2.Range("J" & i).Value, LookIn:=xlValues)

               If Not searchNum Is Nothing Then
                    firstAddress = searchNum.Address

                  Do
                     searchNum.Offset(columnoffset:=3).Copy
                       wsheet1.Range("B" & x).PasteSpecial
                  Loop While Not searchNum Is Nothing And searchNum.Address <> firstAddress
             x = x + 1
            End If
        End With
    End If
    End If
\$\endgroup\$
2
\$\begingroup\$

I've done my best to get you pointed in the right direction, but your code is difficult to follow as is. Here is what I have:

Sub Test()
    Dim wsheet1 As Worksheet
    Set wsheet1 = ActiveWorkbook.Worksheets("Sheet1")

    Dim wsheet2 As Worksheet
    Set wsheet2 = ActiveWorkbook.Worksheets("Sheet2")

    ' Use the Range object, and not the 'Object' object
    Dim data1Range As Range
    Set data1Range = wsheet2.Range(wsheet2.Range("C1"), wsheet2.Cells(Rows.Count, 1).End(xlUp))

    ' I prefer clearer variable names
    Dim InputData As Variant

    ' I am making the somewhat dangerous assumption here that the only data on this sheet is the data you need in the array.
    InputData = wsheet2.UsedRange.value

    ' I am creating this boolean because I am a little too lazy to do a fancier function approach.
    ' This is purely to get a satisfied condition from the Select Case statement, and as a result to skip the corresponding conditional block.
    Dim SatisfiesConditions As Boolean

    ' I dont know what kind of value you're retrieving from the corresponding cells, so I am using variants as a temporary type.
    Dim MatchedValue As Variant
    Dim OffsetValue As Variant

    Dim SearchNum As Range
    Dim FirstAddress As String
    Dim x As Long

    ' I assume here that your data has headers, so I loop from the lowest bound (first row) plus 1 (offset for header row) to the maximum row
    For i = LBound(InputData, 1) + 1 To UBound(data1, 1)
        ' To use an array, reference the array index and not the worksheet index
        ' Additionally, use 'Select Case' for multiple 'Or' conditions.

        SatisfiesCondition = True

        Select Case InputData(i, 3)
            Case "Mike"
            Case "Sam"
            Case "George"
            Case "Abrahim"
            Case Else
                SatisfiesCondition = False
        End Select

        If SatisfiesCondition Then
            MatchedValue = InputData(i, 3)

            ' Since the offset was 7, 3 + 7 = 10
            OffsetValue = InputData(i, 10)

            ' From here down, it is difficult to understand what you are doing. xOffset isn't declared (or assigned)
            If InStr(1, xoffset, "1.") <> 0 Then
                With wsheet2.Range("a1:a" & lastrow)
                    Set SearchNum = .Find(wsheet2.Range("J" & i).value, LookIn:=xlValues)

                    If Not SearchNum Is Nothing Then
                        FirstAddress = SearchNum.Address

                        ' This loop should be infinite since searchNum will always be assigned to the same exact
                        ' address, and as a result the condition will always be satisfied.
                        Do
                            SearchNum.Offset(columnoffset:=3).Copy
                            wsheet1.Range("B" & x).PasteSpecial
                        Loop While Not SearchNum Is Nothing And SearchNum.Address <> FirstAddress
                        x = x + 1
                    End If
                End With
            End If
        End If
    Next
End Sub

I noticed a few points where you code looks as though it shouldnt actually work. You also had a mix of variables declared and never used, and variables used but never declared.

The Big Stuff

First, multiple Dim statements are always preferable to a single Dim statement for multiple variables

Dim Foo as Long
Dim Bar as String
Dim Baz as Worksheet

Is better than

Dim Foo as Long, Bar as String, Baz as Worksheet

It is also best to declare variables as close to first use as possible (outside of loops though). You'll notice that I implemented this in my refactoring of your code.

Option Explicit

I highly encourage the use of Option Explicit within your code. This will give you a compile-time error any time you try to compile your code when a variable is used but undeclared. This helps with things like:

Dim Fooo as String
Fooo = "SomeString"

...many lines later...

If Foo = "SomeString" Then
    ' Never is satisfied since Foo is not the same as Fooo
End If

To make Option Explicit easy, do this: Alt + T Alt + O Editor Tab Make sure 'Require Variable Declaration' is checked

Indentation

Make sure your code is properly indented before posting it. If you did, you would've noticed that you were missing the Next at the end of your For block (which prevents the code from compiling). You would've also noticed the lack of Sub and End Sub.

Select Case vs. If...Or...Or...Or...Or...

Any time you are doing multiple "If it is this, or that, or..." conditionals, you should use a Select Case statement. There is a slight performance increase, but it is also cleaner and easier to read.

Additionally, it makes it easy to edit the conditions as needed.

Select Case works by taking an input variable, and checking the condition against Case's. If the condition matches, it runs the code inside the Case block, otherwise it goes to Case Else or End Select in the absence of Case Else.

For example:

Dim Foo as String
Foo = "Apple"

Select Case Foo
Case "Apple"
    msgbox "Foo is an Apple!"
Case "Pear"
    msgbox 'Foo is a Pear!'
Case "Orange"
    msgbox "Foo is an Orange!"
Case Else
    msgbox "Foo is an " & Foo & "!"
End Select

' Outputs a messagebox that says "Foo is an Apple!"

Dim Foo as String
Foo = "Banana"

Select Case Foo
Case "Apple"
    msgbox "Foo is an Apple!"
Case "Pear"
    msgbox 'Foo is a Pear!'
Case "Orange"
    msgbox "Foo is an Orange!"
Case Else
    msgbox "Foo is an " & Foo & "!"
End Select

' Outputs a messagebox that says "Foo is a Banana!"

The beauty of Select Case is that you can have code within the Case Blocks or you can leave them empty and only have code in the Case Else block.

Arrays

This is the meat of what you are looking for. From your code, it looks like you misunderstood how to use arrays. Basically, arrays improve performance when the computations are done in the array (this is because they are being done in-memory versus in-worksheet).

When using an array for your purposes I would suggest setting the array equal to the entire range with your data in it. So for example, if you have a table on worksheet Sheet in `Range("A1:Z100") your array would be:

Dim SomeArray as Variant
SomeArray = ThisWorkbook.Worksheets("Sheet1").Range("A1:Z100").Value

This will return a 1-Based array that you can then loop through. Now, for example, if Column "C" should equal "B" * "A" you can do this:

Dim i as Long
For i = LBound(SomeArray, 1) + 1 to Ubound(SomeArray, 1)
    If IsNumeric(SomeArray(i, 1)) and IsNumeric(SomeArray(i, 2)) Then
        SomeArray(i, 3) = SomeArray(i, 2) * SomeArray(i, 3)
    End If
Next

Then we can quickly output it to the worksheet when we are done:

ThisWorkbook.Sheets("Sheet1").Range("A1:Z100").Value = SomeArray

Voila! We now have completed our computations much faster than if we had done the same thing on the worksheet.

I would recommend practicing with arrays and spending some time understanding what they do, how they work, and how to loop through them. They are very powerful when used well.

Rubberduck

If you haven't heard of it before, there is a tool called "RubberDuck" that can help tremendously with refining your code. It has inspections that can catch a lot of the common mistakes. It also improves the Project Explorer window immensely. Check it out here: http://rubberduckvba.com/

Locals, Immediate, and Watch Windows

If you aren't using these windows already you definitely should be. They make debugging much easier, and it also improves your ability to step through your code. You can find them in the 'View' menu of the IDE.

Best of luck!

\$\endgroup\$
  • \$\begingroup\$ Putting each Dim on its own line also helps find things like the Dim data1 buried deep toward the end of the Dim line. It was implicitly declaring data1 as Variant, which happened to be what was desired in this case, but wasn't abundantly clear from the code. \$\endgroup\$ – FreeMan Jul 25 '17 at 17:49
  • \$\begingroup\$ @Brandon Brney Thanks a lot. I really appreciate it. It made 15secs faster i think i have to work on second part. Second part where you mentioned didn't understand. What i did basically- take the value of xoffset and search for the value again in A column, once i found the xoffset in A column I wen to corresponding column 5 and copy that column and paste into another sheet. \$\endgroup\$ – user3795861 Aug 1 '17 at 14:45
  • \$\begingroup\$ @user3795861 You mean the arrays? Treat an array almost like you are treating your sheet. An array is indexed by row, column, so if I want the value of A1 I would do SomeArray(1,1) if I want C1 I would do SomeArray(1, 3), so on so forth. The arrays will speed up your code significantly. \$\endgroup\$ – Brandon Barney Aug 1 '17 at 18:24
  • \$\begingroup\$ @BrandonBarney I did used InputData = wsheet2.UsedRange.Value. Then InputData(i,3) but still slow \$\endgroup\$ – user3795861 Aug 1 '17 at 19:12
  • \$\begingroup\$ @user3795861 And you arent using worksheet references elsewhere? Any time you do something like SomeRange.Value = SomeValue you will notice an inefficiency. Also, how slow are we talking? \$\endgroup\$ – Brandon Barney Aug 1 '17 at 19:21
1
\$\begingroup\$

While agreeing with Brandon Barney, I missed a very obviuos performance speedup when changing worksheets through vba.

sub mySub()
  'Begin your sub/function with:
  application.screenupdating  = false
  application.enableevents = false
  application.calculation = xlmanual

  'The above speedsup execution time, because it holds updating the screen 
  'until and it blocks event triggering and it will not automatically 
  'calculate formulas until these are activated again.
  '
  'Therefore end your sub/function with the reverse:
  application.screenupdating = true
  application.enableevents = true
  application.calculation = xlautomatic
end sub

if you want to be a little bit more flexibel you could opt for the following:

sub MySub()
  dim SU as boolean
  dim EE as boolean
  dim CC as variant
  SU = application.screenupdating
  EE = application.enableevents
  CC = application.calculation
  application.screenupdating = false
  application.enableevents = false
  application.calculation = xlmanual

  'DO YOUR STUFF

  application.screenupdating = SU
  application.enableevents = EE
  application.calculation = CC
end sub

Thus always reverting to the state before executing the sub/function.

\$\endgroup\$

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.