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.
3 Answers 3
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".
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.
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
-
2\$\begingroup\$ Your answer could really benefit from some explanation as to what you are suggesting and why. \$\endgroup\$forsvarir– forsvarir2016年08月29日 10:57:00 +00:00Commented 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\$Mathieu Guindon– Mathieu Guindon2016年08月29日 14:31:45 +00:00Commented 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– R2D22016年10月30日 22:00:43 +00:00Commented Oct 30, 2016 at 22:00
moRow(mo)
. \$\endgroup\$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\$'Tag Information
. @Mikegrann thank you for your array recommendation. I'll take a look at that. \$\endgroup\$