3
\$\begingroup\$

I have this program on Excel VBA, that implements a userform in order to simplify input and to create control charts from the data input analyze the data and send emails if certain conditions are met.

My problem is that everything works properly but after running line by line I noticed that when filling up the corresponding cells in excel with the user input on the userform the macro takes long to execute each line.

I am wondering if any of you have a different method of doing this that would reduce the time it takes to run through all these lines.

Function completeData(mo As String)

Dim row As Integer
row = moRow(mo)
DataHistory

'Tag Information
Worksheets("Data").Cells(row, 2).value = ComboBox1.value 'set UPC
Worksheets("Data").Cells(row, 4).value = TextBox2.value 'set DateCured
Worksheets("Data").Cells(row, 5).value = TextBox48.value 'set DateTested
Worksheets("Data").Cells(row, 41).value = ComboBox2.value 'set Grinder
Worksheets("Data").Cells(row, 42).value = ComboBox3.value 'set Metal
Worksheets("Data").Cells(row, 43).value = ComboBox4.value 'set Press
Worksheets("Data").Cells(row, 44).value = ComboBox5.value 'set Clock
Worksheets("Data").Cells(row, 45).value = ComboBox6.value 'set Oven

'weight 0min Wheels
Worksheets("Data").Cells(row, 15).value = TextBox3.value
Worksheets("Data").Cells(row + 1, 15).value = TextBox4.value
Worksheets("Data").Cells(row + 2, 15).value = TextBox5.value

'Before Thikness
''''FirstWheel
Worksheets("Data").Cells(row, 6).value = TextBox6.value
Worksheets("Data").Cells(row, 7).value = TextBox7.value
Worksheets("Data").Cells(row, 8).value = TextBox8.value
Worksheets("Data").Cells(row, 9).value = TextBox9.value
''''SecondWheel
Worksheets("Data").Cells(row + 1, 6).value = TextBox10.value
Worksheets("Data").Cells(row + 1, 7).value = TextBox11.value
Worksheets("Data").Cells(row + 1, 8).value = TextBox12.value
Worksheets("Data").Cells(row + 1, 9).value = TextBox13.value
''''ThirdWheel
Worksheets("Data").Cells(row + 2, 6).value = TextBox14.value
Worksheets("Data").Cells(row + 2, 7).value = TextBox15.value
Worksheets("Data").Cells(row + 2, 8).value = TextBox16.value
Worksheets("Data").Cells(row + 2, 9).value = TextBox17.value

'Balance
Worksheets("Data").Cells(row, 11).value = TextBox18.value
Worksheets("Data").Cells(row + 1, 11).value = TextBox19.value
Worksheets("Data").Cells(row + 2, 11).value = TextBox20.value

'weight 0min Material
Worksheets("Data").Cells(row, 19).value = TextBox21.value
Worksheets("Data").Cells(row + 1, 19).value = TextBox22.value
Worksheets("Data").Cells(row + 2, 19).value = TextBox23.value

'After 5min
'''Wheels
Worksheets("Data").Cells(row, 16).value = TextBox24.value
Worksheets("Data").Cells(row + 1, 16).value = TextBox25.value
Worksheets("Data").Cells(row + 2, 16).value = TextBox26.value
'''Metal
Worksheets("Data").Cells(row, 20).value = TextBox27.value
Worksheets("Data").Cells(row + 1, 20).value = TextBox28.value
Worksheets("Data").Cells(row + 2, 20).value = TextBox29.value
'checkSpallin 5 min
If CheckBox1.value = True Then Worksheets("Data").Cells(row, 12).value = "Y"
If CheckBox2.value = True Then Worksheets("Data").Cells(row + 1, 12).value = "Y"
If CheckBox3.value = True Then Worksheets("Data").Cells(row + 2, 12).value = "Y"

'Grinding from 5min to 10min metal initial weight
Worksheets("Data").Cells(row, 21).value = TextBox30.value
Worksheets("Data").Cells(row + 1, 21).value = TextBox31.value
Worksheets("Data").Cells(row + 2, 21).value = TextBox32.value

'After 10min
'''Wheels
Worksheets("Data").Cells(row, 17).value = TextBox33.value
Worksheets("Data").Cells(row + 1, 17).value = TextBox34.value
Worksheets("Data").Cells(row + 2, 17).value = TextBox35.value
'''Metal
Worksheets("Data").Cells(row, 22).value = TextBox36.value
Worksheets("Data").Cells(row + 1, 22).value = TextBox37.value
Worksheets("Data").Cells(row + 2, 22).value = TextBox38.value
'checkSpallin 10 min
If CheckBox4.value = True Then Worksheets("Data").Cells(row, 13).value = "Y"
If CheckBox5.value = True Then Worksheets("Data").Cells(row + 1, 13).value = "Y"
If CheckBox6.value = True Then Worksheets("Data").Cells(row + 2, 13).value = "Y"

'Grinding from 10min to 15min metal initial weight
Worksheets("Data").Cells(row, 23).value = TextBox39.value
Worksheets("Data").Cells(row + 1, 23).value = TextBox40.value
Worksheets("Data").Cells(row + 2, 23).value = TextBox41.value

'After 15min
'''Wheels
Worksheets("Data").Cells(row, 18).value = TextBox42.value
Worksheets("Data").Cells(row + 1, 18).value = TextBox43.value
Worksheets("Data").Cells(row + 2, 18).value = TextBox44.value
'''Metal
Worksheets("Data").Cells(row, 24).value = TextBox45.value
Worksheets("Data").Cells(row + 1, 24).value = TextBox46.value
Worksheets("Data").Cells(row + 2, 24).value = TextBox47.value
'checkSpallin 15 min
If CheckBox7.value = True Then Worksheets("Data").Cells(row, 14).value = "Y"
If CheckBox8.value = True Then Worksheets("Data").Cells(row + 1, 14).value = "Y"
If CheckBox9.value = True Then Worksheets("Data").Cells(row + 2, 14).value = "Y"

End Function

Like I said, it works but it takes long to finish. Essentially this is what is consuming time. I don't know what to implement to make it run faster. Any ideas are welcome.

\$\endgroup\$
7
  • 2
    \$\begingroup\$ There is no reason for this code to take a second to execute. Does the Data worksheet contain a lot of formulas? Please post the code for moRow(mo). \$\endgroup\$
    – user109261
    Aug 22, 2016 at 16:21
  • 1
    \$\begingroup\$ What's DataHistory doing? You'll want to include it in your post, since it might be where your bottleneck is. What code is caling this function? Is it called in a loop? This definitely looks like a Code Review question, but it will need a bit more context to be meaningfully answered. \$\endgroup\$ Aug 22, 2016 at 16:23
  • \$\begingroup\$ moRow finds row, DataHistory is meant to set a record for the combobox. That said, those two lines take O(1) to execute, what is taking long is each line after 'Tag Information. @Mikegrann thank you for your array recommendation. I'll take a look at that. \$\endgroup\$
    – Jorge Vargas Moreno
    Aug 22, 2016 at 16:27
  • \$\begingroup\$ The rest of the code also executes in constant time. That doesn't mean it's the part slowing you down. Direct assignments into cell values are slow, but Thomas is right when he says that it shouldn't take nearly as long as described for a single run. Look at your other procedures again for possible slowdowns. \$\endgroup\$
    – Mikegrann
    Aug 22, 2016 at 16:31
  • 1
    \$\begingroup\$ A With ... End With statement would not only clean up the code but improve its execution time. edit Since you are not returning a value, this would be better as a Sub rather than a Function. \$\endgroup\$
    – user66882
    Aug 22, 2016 at 16:35

3 Answers 3

6
\$\begingroup\$

The first thing to do is to switch off calculation, sheet events and screen updating before you write anything to a worksheet, and restore it when you're done: that way you won't have Excel try to re-calculate the entire workbook whenever you write to a cell.

Next, name things, starting with the "Data" sheet. Select the worksheet in the Project Explorer (Ctrl+R), then bring up the Properties toolwindow (F4) and type DataSheet under the sheet's (name) property.

Then you can do this:

With DataSheet
    .Cells(...).Value = ...
    .Cells(...).Value = ...
    .Cells(...).Value = ...
    .Cells(...).Value = ...
    .Cells(...).Value = ...
    .Cells(...).Value = ...
    .Cells(...).Value = ...
    ...
End With

In the form's designer (F7), give each control a meaningful name. For example ComboBox1 contains a UPC code, so it should be named SelectedUPC.

The problem with this is that you already have tons of code referring to these controls, and renaming ComboBox1 to SelectUPC would break your code, because ComboBox1 would be left referring to nothing.

You'll need tools to do this cleanly. Fortunately Rubberduck can help with this refactoring:

Rubberduck's 'Rename' refactoring can rename UserForm controls

You could right-click on a control, select Rubberduck > Rename (or right-click a ComboBox1 identifier reference in the code, select Rubberduck > Refactor > Rename), then specify SelectedUPC as the new name, and then...

Rubberduck handles in-code identifier references and event handlers for the renamed control

Rubberduck renames the associated event handler(s) and in-code identifier references for you - so there's no excuse for having meaningless identifiers anywhere anymore.


DISCLAIMER I'm heavily involved with the Rubberduck project.


Speaking of naming, it's not clear at all what moRow means to be doing, nor who is calling that function, or even why it needs to be a Function.

Procedures that don't return a value should be Sub procedures; a Sub procedure executes a sequence of operations; a Function procedure computes a value and returns it to the caller.

Also, module members in VBA are implicitly Public, which means completeData (which should be CompleteData to be PascalCase like all other VBA procedures) is a public member of that UserForm.

I'd strongly recommend reading up on VBA UserForm best practices, and restructure your code so that the form doesn't "run the show": the form should be there only to provide the rest of the code with user input, not to actually perform the worksheet manipulations - a form's code-behind should only be concerned about the form and its controls; a form that knows about a worksheet, plainly knows (and does) too many things.

I'd also suggest you define an enum to name each column of your "Data" sheet, so instead of this:

With DataSheet
    .Cells(row, 2).Value = SelectedUPC.Value

You would have that:

With DataSheet
    .Cells(row, DataSheetColumns.UPC).Value = SelectedUPC.Value

All that's needed is a simple declaration:

Private Enum DataSheetColumns
    UPC = 2
    DateCured = 4
    DateTested = 5
    ...
End Enum

That makes it much easier to read the rest of the code, and seeing DataSheetColumns.UPC being assigned to SelectedClock.Value looks much more wrong than if it's column 44 being assigned: making wrong code look wrong is even more important than writing code that "works".

\$\endgroup\$
0
\$\begingroup\$

You are writing to a lot of cells one at a time, which can be slow. Your output doesn't go into a single block of cells, which is too bad, but you can still make it faster by building an array wherever possible and dumping this array into the sheet in one shot.

For example, this block

'Before Thikness
''''FirstWheel
Worksheets("Data").Cells(row, 6).value = TextBox6.value
Worksheets("Data").Cells(row, 7).value = TextBox7.value
Worksheets("Data").Cells(row, 8).value = TextBox8.value
Worksheets("Data").Cells(row, 9).value = TextBox9.value
''''SecondWheel
Worksheets("Data").Cells(row + 1, 6).value = TextBox10.value
Worksheets("Data").Cells(row + 1, 7).value = TextBox11.value
Worksheets("Data").Cells(row + 1, 8).value = TextBox12.value
Worksheets("Data").Cells(row + 1, 9).value = TextBox13.value
''''ThirdWheel
Worksheets("Data").Cells(row + 2, 6).value = TextBox14.value
Worksheets("Data").Cells(row + 2, 7).value = TextBox15.value
Worksheets("Data").Cells(row + 2, 8).value = TextBox16.value
Worksheets("Data").Cells(row + 2, 9).value = TextBox17.value

can be streamlined like this:

'Before Thikness
Dim vOutput As Variant
ReDim vOutput(1 To 3, 1 To 4)
''''FirstWheel
vOutput(1, 1) = TextBox6.value
vOutput(1, 2) = TextBox7.value
vOutput(1, 3) = TextBox8.value
vOutput(1, 4) = TextBox9.value
''''SecondWheel
vOutput(2, 1).value = TextBox10.value
vOutput(2, 2) = TextBox11.value
vOutput(2, 3) = TextBox12.value
vOutput(2, 4) = TextBox13.value
''''ThirdWheel
vOutput(3, 1) = TextBox14.value
vOutput(3, 2) = TextBox15.value
vOutput(3, 3) = TextBox16.value
vOutput(3, 4) = TextBox17.value
''''Dump to worksheet
Worksheets("Data").Cells(row, 6).Resize(3, 4).Value = vOutput

Do this wherever there are blocks of output.

At the same time, follow the suggestions to turn off screen updating and automatic calculations.

\$\endgroup\$
-2
\$\begingroup\$

Option Explicit

Function completeData(mo As String)

Application.ScreenUpdating = False

Dim row As LongPtr

row = moRow(mo)

...rest of code

Application.ScreenUpdating = True

End Function

\$\endgroup\$
3
  • 2
    \$\begingroup\$ Your answer could really benefit from some explanation as to what you are suggesting and why. \$\endgroup\$
    – forsvarir
    Aug 29, 2016 at 10:57
  • \$\begingroup\$ What's the LongPtr for? What's the rationale behind it? What if the code needs to run on 32-bit Office? Please take a minute to edit your answer to clarify - a code dump is scarcely a well-received answer on this site. \$\endgroup\$ Aug 29, 2016 at 14:31
  • \$\begingroup\$ LongPtr is a long integer pointer data type. it helps the macro to run a bit quicker for integer values such as row numbers. I am not sure if this is a problem on 32 bit office. Though I have found Long Integer Pointer LongPtr to be useful for running through rows in large text file counts and also large excel worksheets quicker than the integer data type. Using non-variant data types where possible speeds up the macro. \$\endgroup\$
    – R2D2
    Oct 30, 2016 at 22:00

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.