0
\$\begingroup\$

I am creating an estimation tool, where users can input part numbers and quantities, and the tool will output the lowest cost for that part number based on searches through multiple databases.

I accomplish this by loading data into multiple sheets and then evaluate all possibilities on one sheet.

I believe my code is struggling, because I have multiple instances of this loop below which I'm hoping someone can help me improve. The code below runs 3 separate times, for 3 different sheets. There can be up-to 1000 part numbers run at a time. Once the tool has been run, to start over I delete all the sheets, so each sheet is created every time the macro runs.

'Add Content to Summary

       'MPN and Qty add to Summary page
            Sheet22.Visible = True
            Sheet1.Select
            Range("A2").Select

            Sheet22.Select
            Range("A2").Select

            For i = 1 To 3
            Sheet1.Select
            If Len(ActiveCell.Value) > 0 Then

            xmpn = ActiveCell.Value
            xqty = ActiveCell.Offset(0, 1).Value

            Sheet22.Select
            ActiveCell.Value = xmpn
            ActiveCell.Offset(0, 1).Value = xqty
            ActiveCell.Offset(1, 0).Select
            Sheet1.Select
            ActiveCell.Offset(1, 0).Select

            Else
                i = 10
            End If
                i = i - 1
            Next

If there are 1000 part number entries, this code can take about 45 seconds to run, and causes excel to show not responding. Any help or suggestions to improve would be greatly appreciated.

\$\endgroup\$
  • \$\begingroup\$ You should probably search directly in the database. \$\endgroup\$ – krish KM Nov 23 '18 at 19:40
  • 1
    \$\begingroup\$ It would be best to work with the data in memory. But if you do write it to the worksheet this video will help immensely: Excel VBA Introduction Part 5 - Selecting Cells (Range, Cells, Activecell, End, Offset). You should also watch: Excel VBA Introduction Part 25 - Arrays \$\endgroup\$ – TinMan Nov 24 '18 at 7:49
  • \$\begingroup\$ @krishKM - Yes I am searching directly in 6 different databases, however 1 of them is through an excel add in which connects via an excel formula. and the other 2 instances of this loop are for the summary page and the evaluation page. \$\endgroup\$ – Aaron Bates Nov 26 '18 at 14:52
  • \$\begingroup\$ @TinMan - I will check out those videos, thanks for the suggestion! \$\endgroup\$ – Aaron Bates Nov 26 '18 at 14:53
0
\$\begingroup\$

Your answer is a big step up from your original code but we can do better.

Dimension2 = 1 does no do anything. Dimension2 is being initiated in the For loop.

Selecting and Activating Objects

It is rarely necessary to Select or Activate an Object. You should to fully qualify your Objects rather than it is to rely on the default active objects. Fully qualifying references will make your code more robust and easier to debug.

Sheet22.Visible = True
Sheet22.Activate

Above you are temporarily making Sheet22 visible and active when all you need to do is qualify the range.

For Dimension1 = LBound(MpnQty, 1) To UBound(MpnQty, 1)
    For Dimension2 = LBound(MpnQty, 2) To UBound(MpnQty, 2)
        Sheet22.Range("A2").Offset(Dimension1, Dimension2).Value = MpnQty(Dimension1, Dimension2)
    Next Dimension2
Next Dimension

Consider using a temp variable to shorten the worksheet reference.

Dim ws1 as Worksheet
Set ws = Sheet1
Dimension1 = ws1.Range("A2", ws1.Range("A2").End(xlDown)).Count - 1

I prefer to use With Blocks

With Sheet1 
    Dimension1 = .Range("A2", .Range("A2").End(xlDown)).Count - 1
End With

Note: I omitted Cells because it is the default property of Range.

Ranges and Arrays

Range("A2").Value returns a single scalar value because it contains only one cell. Range("A2:B2").Value is a multiple cell range which returns an array of values that can be directly assigned to a variant variable or another range.

There are several nuances to resizing ranges, assigning ranges values to variants and assigning arrays to ranges. So practice!!

Refactored Code

Here is how I would write it:

Dim Data() As Variant

With Sheet1
    Data = .Range("A2:B2", .Range("A2").End(xlDown)).Value
End With

With Sheet22
    Data = .Range("A2:B2").Resize(UBound(Data), UBound(Data, 2)).Value = Data
End With
\$\endgroup\$
  • \$\begingroup\$ Thank you TinMan, very helpful suggestions here. I have removed the temporary visible and activate from the code and now qualify the range as you suggested above. \$\endgroup\$ – Aaron Bates Nov 28 '18 at 17:01
  • \$\begingroup\$ I am using the Dimension 2 in the code to select A2:B2. I'm not sure your refactored code addresses this. Can you also clarify - for the refactored code in the with blocks for sheet 22 should not include 'Data =' at the start, but only at the end? \$\endgroup\$ – Aaron Bates Nov 28 '18 at 17:12
  • \$\begingroup\$ @AaronBates I did miss that. I updates my answer. \$\endgroup\$ – TinMan Nov 28 '18 at 17:26
  • \$\begingroup\$ I am now using your refactored code, it is lightening fast and makes the code easily readable :) \$\endgroup\$ – Aaron Bates Nov 28 '18 at 17:51
1
\$\begingroup\$

Based on the array video provided by TinMan, I now declared the data as an array, and then populate each tab referencing the array. The code is now instantaneous for 1000s records.

Thanks TinMan!!

'Set MpnQty array

Dim MpnQty() As Variant
Dim Dimension1 As Long, Dimension2 As Long

Sheet1.Activate

Dimension1 = Range("A2", Range("A2").End(xlDown)).Cells.Count - 1
Dimension2 = 1

ReDim MpnQty(0 To Dimension1, 0 To Dimension2)

For Dimension1 = LBound(MpnQty, 1) To UBound(MpnQty, 1)
    For Dimension2 = LBound(MpnQty, 2) To UBound(MpnQty, 2)
        MpnQty(Dimension1, Dimension2) = Range("A2").Offset(Dimension1,   Dimension2).Value
    Next Dimension2
Next Dimension1

'Add MPN and Qty to Summary page

Sheet22.Visible = True
Sheet22.Activate

For Dimension1 = LBound(MpnQty, 1) To UBound(MpnQty, 1)
    For Dimension2 = LBound(MpnQty, 2) To UBound(MpnQty, 2)
        Range("A2").Offset(Dimension1, Dimension2).Value = MpnQty(Dimension1, Dimension2)
    Next Dimension2
Next Dimension 
\$\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.