Excel Forum

Transfer of data slow when pressing command button

Helen Warburton

Member

Members

Forum Posts: 20

Member Since:
November 16, 2020

Offline

November 16, 2020 - 11:05 pm

Hi,

I have 8 text boxes, 4 combo boxes and 3 list boxes on a userform along with a textbox which automatically generates a new Test Request Number (TRN).

The multi select listbox called TestsRequired contains a list of tests which the user selects from. This is dropped in to column M on the next empty row.

When I press the command button (OK) at the bottom of the form, this drops all of these boxes on to the next empty row in the form.

It then copies columns A to J down depending on the number of tests inputted in to column M.

The issue I am having is that the transfer of data when pressing OK is taking forever to load.

Sheet1.Activate

Dim emptyrow As Long
emptyrow = Cells(Rows.Count, "A").End(xlUp).Row + 1

Cells(emptyrow, 1).Value = TRNNumber.Value
Cells(emptyrow, 2).Value = DateRequested.Value
Cells(emptyrow, 3).Value = TestHouse.Value
Cells(emptyrow, 4).Value = ProductName.Value
Cells(emptyrow, 5).Value = Shade.Value
Cells(emptyrow, 6).Value = POFabric.Value
Cells(emptyrow, 7).Value = Supplier.Value
Cells(emptyrow, 8).Value = TestRequestedBy.Value
Cells(emptyrow, 9).Value = TestAuthorisedBy.Value
Cells(emptyrow, 10).Value = GLCode.Value
Cells(emptyrow, 14).Value = Other.Value
Cells(emptyrow, 14).Value = Other2.Value
Cells(emptyrow, 21).Value = Ironing.Value

For i = 0 To TestsRequired.ListCount - 1
If TestsRequired.Selected(i) Then
Range("M" & Rows.Count).End(xlUp).Offset(1).Value = TestsRequired.List(i)
End If
Next i

For i = 0 To Washing.ListCount - 1
If Washing.Selected(i) Then
Range("T" & Rows.Count).End(xlUp).Offset(1).Value = Washing.List(i)
End If
Next i

For i = 0 To Drying.ListCount - 1
If Drying.Selected(i) Then
Range("U" & Rows.Count).End(xlUp).Offset(1).Value = Drying.List(i)
End If
Next i

For Each area In Columns("A:J").SpecialCells(xlCellTypeBlanks)
If area.Cells.Row <= ActiveSheet.UsedRange.Rows.Count Then
area.Cells = Range(area.Address).Offset(-1, 0).Value
End If
Next area

Does anyone have any ideas how I can make this quicker?

Thank you so much for your help.

See Answer

Philip Treacy

Admin

Forum Posts: 1614

Member Since:
October 5, 2010

Offline

November 17, 2020 - 8:56 am

Hi Helen,

Nothing in the code jumps out at me but I don't know what values the various ListCounts take. If they are very large for some reason that could slow things.

I'd need to see your workbook/code/form to check anything else.

Regards

Phil

Warren Hall

New Member

Members

Forum Posts: 2

Member Since:
November 17, 2020

Offline

November 17, 2020 - 11:09 am

The first thing that comes to mind is to change the data tables to arrays. This almost always gives speed increases of ten to a hundred times faster.

Catalin Bombea

Iasi, Romania

Member

Dashboards

Power Query

Power Pivot

Xtreme Pivot Tables

Excel for Decision Making

Excel for Finance

Excel Analysis Toolpak

Power BI

Excel

Word

Outlook

Excel Expert

Excel Customer Service

PowerPoint

Forum Posts: 1939

Member Since:
November 8, 2013

Offline

November 17, 2020 - 1:17 pm

Warren is right, but:
For Each area In Columns("A:J").SpecialCells(xlCellTypeBlanks)
If area.Cells.Row <= ActiveSheet.UsedRange.Rows.Count Then
area.Cells = Range(area.Address).Offset(-1, 0).Value
End If
Next area

Why are you evaluating 10 full columns - A:J, with 1 million+ rows each? There can be a lot of blank cells.

I don't understand what's the purpose of this code, so you need to clarify things.

Helen Warburton

Member

Members

Forum Posts: 20

Member Since:
November 16, 2020

Offline

November 18, 2020 - 2:40 am

Hi All,

Thank you very much for replying so quickly.

The reason for copying the code down is I have a multi page userform which has some tabs which refer to the data stored in columns A to J. When I add values from the listbox TestsRequired in to column M, I only need to copy columns A to J for the number of rows I have added in to column M but as I am still learning VBA I do not know how to do this.

I have attached the file to this reply to see if anyone can work out why it is so slow.

Thank you very much.

Catalin Bombea

Iasi, Romania

Member

Forum Posts: 1939

Member Since:
November 8, 2013

Offline

November 18, 2020 - 12:47 pm

You have 2 options:
Put an exit if you have exceeded the used range, so your code will not examine 10+million cells:

For Each area In Columns("A:J").SpecialCells(xlCellTypeBlanks)
     If area.Cells.Row <= ActiveSheet.UsedRange.Rows.Count Then
          area.Cells = Range(area.Address).Offset(-1, 0).Value
     Else

exit for
End If
Next area

Or, put repeatable code into a separate procedure and call it from the main procedure:

Private Sub OK_Click()
Dim wks As Worksheet: Set wks = ThisWorkbook.Worksheets("Sheet1")
For i = 0 To TestsRequired.ListCount - 1
If TestsRequired.Selected(i) Then
FillAJData wks, "M", TestsRequired.List(i)
End If
Next i

For i = 0 To Washing.ListCount - 1
If Washing.Selected(i) Then
FillAJData wks, "T", Washing.List(i)
End If
Next i

For i = 0 To Drying.ListCount - 1
If Drying.Selected(i) Then
FillAJData wks, "U", Drying.List(i)
End If
Next i
Set wks = Nothing
End Sub
Sub FillAJData(ByVal wks As Worksheet, ByVal rng As String, RngValue As String)

Dim emptyrow As Long

With wks
emptyrow = .Cells.Find("*", .Cells(1), , , xlByRows, xlPrevious).Row + 1
.Cells(emptyrow, 1).Value = TRNNumber.Value
.Cells(emptyrow, 2).Value = DateRequested.Value
.Cells(emptyrow, 3).Value = TestHouse.Value
.Cells(emptyrow, 4).Value = ProductName.Value
.Cells(emptyrow, 5).Value = Shade.Value
.Cells(emptyrow, 6).Value = POFabric.Value
.Cells(emptyrow, 7).Value = Supplier.Value
.Cells(emptyrow, 8).Value = TestRequestedBy.Value
.Cells(emptyrow, 9).Value = TestAuthorisedBy.Value
.Cells(emptyrow, 10).Value = GLCode.Value
.Cells(emptyrow, 14).Value = Other.Value
.Cells(emptyrow, 14).Value = Other2.Value
.Cells(emptyrow, 21).Value = Ironing.Value
.Cells(emptyrow, rng).Value = RngValue
End With

End Sub

Helen Warburton

Member

Members

Forum Posts: 20

Member Since:
November 16, 2020

Offline

November 18, 2020 - 7:10 pm

Thank you for the 2 options.

I prefer the 2nd option as if someone does not add something in to one of the textboxes from columns A to J then it does not copy these down.

However, this is still taking approx. 15 seconds to add 3 lines of data. Is this usual? Just seems to take longer than I am used to from any code I have done before.

Sorry for this just would like to understand if there is anything I can do about it.

Catalin Bombea

Iasi, Romania

Member

Forum Posts: 1939

Member Since:
November 8, 2013

Offline

November 19, 2020 - 1:53 pm

I think it's related to the structure of your file, if you have many formulas and calculation is automatic, things are slow.

You can disable calculation from code with:

application.Calculation=xlCalculationManual

After the code finishes writing data, turn back to automatic:

application.Calculation=xlCalculationAutomatic

Or, as Warren suggested, you can collect the data into an array and drop the array into cells in one action instead of writing cell by cell.

Helen Warburton

Member

Members

Forum Posts: 20

Member Since:
November 16, 2020

Offline

November 19, 2020 - 9:55 pm

Thank you very much - I will try this 🙂

How would I structure an Array? Do you maybe have a link to somewhere I could use?

I have never done one before so not sure how to write the code for it.

Thanks again for your help.

Catalin Bombea

Iasi, Romania

Member

Forum Posts: 1939

Member Since:
November 8, 2013

Offline

November 20, 2020 - 1:30 pm

If you disable calculation, the transfer to sheet will be almost instant, in less than 1 second.
Because you have just a few rows to add, what you have already should be enough, an array is best for larger data sets.

Catalin Bombea

Iasi, Romania

Member

Forum Posts: 1939

Member Since:
November 8, 2013

Offline

November 20, 2020 - 2:59 pm

Here is an example of collecting data into an array and transfer to sheet.

Note that the transfer is instant if you disable calculation manually before running the form (Formulas tab in ribbon>Calculation>Manual), in both versions (array or non array method)

What takes a few seconds is disabling and enabling calculation from code, not data transfer.

Private Sub OK_Click()
Dim wks As Worksheet: Set wks = ThisWorkbook.Worksheets("Sheet1")

Dim Arr() As Variant, Counter As Long
Counter = 1
For i = 0 To TestsRequired.ListCount - 1
If TestsRequired.Selected(i) Then FillAJData Arr, Counter, 13, TestsRequired.List(i)
Next i
For i = 0 To Washing.ListCount - 1
If Washing.Selected(i) Then FillAJData Arr, Counter, 20, Washing.List(i)
Next i
For i = 0 To Drying.ListCount - 1
If Drying.Selected(i) Then FillAJData Arr, Counter, 21, Drying.List(i)
Next i
Dim emptyrow As Long
emptyrow = wks.Cells.Find("*", wks.Cells(1), , , xlByRows, xlPrevious).Row + 1

'array is filled, transpose and fill to sheet
'Application.Calculation = xlCalculationManual
wks.Cells(emptyrow, 1).Resize(UBound(Arr, 2), UBound(Arr, 1)).Value = TransposeArray(Arr)
'Application.Calculation = xlCalculationAutomatic

Set wks = Nothing
Unload Me
End Sub
Public Function TransposeArray(myarray As Variant) As Variant
Dim X As Long
Dim Y As Long
Dim Xupper As Long
Dim Yupper As Long
Dim tempArray As Variant
Xupper = UBound(myarray, 2)
Yupper = UBound(myarray, 1)
ReDim tempArray(LBound(myarray, 2) To Xupper, LBound(myarray, 1) To Yupper)
For X = LBound(myarray, 2) To Xupper
For Y = LBound(myarray, 1) To Yupper
tempArray(X, Y) = myarray(Y, X)
Next Y
Next X
TransposeArray = tempArray
End Function
Sub FillAJData(ByRef Arr As Variant, ByRef Counter As Long, ByVal Col As Byte, RngValue As String)
ReDim Preserve Arr(1 To 21, 1 To Counter)
Arr(1, Counter) = TRNNumber.Value
Arr(2, Counter) = DateRequested.Value
Arr(3, Counter) = TestHouse.Value
Arr(4, Counter) = ProductName.Value
Arr(5, Counter) = Shade.Value
Arr(6, Counter) = POFabric.Value
Arr(7, Counter) = Supplier.Value
Arr(8, Counter) = TestRequestedBy.Value
Arr(9, Counter) = TestAuthorisedBy.Value
Arr(10, Counter) = GLCode.Value
Arr(14, Counter) = Other.Value
Arr(14, Counter) = Other2.Value
Arr(21, Counter) = Ironing.Value
Arr(Col, Counter) = RngValue
Counter = Counter + 1
End Sub

Answers Post

Catalin Bombea

Iasi, Romania

Member

Forum Posts: 1939

Member Since:
November 8, 2013

Offline

November 20, 2020 - 3:04 pm

You also have to review what you are doing with that form data, some values are written in the same place without any sense (to me at least):

Cells(emptyrow, 14).Value = Other.Value
Cells(emptyrow, 14).Value = Other2.Value

Cells(emptyrow, 21).Value = Ironing.Value
Range("U" & Rows.Count).End(xlUp).Offset(1).Value = Drying.List(i)

In column 14, you are sending 2 values, obviously only the last one will remain.

In column 21, which is column "U", you are sending once the Ironing value, which will be overwritten by Drying value, if any.

Helen Warburton

Member

Members

Forum Posts: 20

Member Since:
November 16, 2020

Offline

November 23, 2020 - 10:49 pm

That is brilliant thank you - Will give the array code a try once the forms are completed.

The Other and Other 2 should be based on what has been selected in the Listbox but not sure if I have done the code for that correctly. So the Other box only shows when Martindale is selected from the TestsRequested listbox and Other 2 only shows when Other (please specify) is selected from the TestsRequested listbox.

The ironing and drying is a typo - thank you for pointing it out! Will have to get that fixed!