• Skip to main content
  • Skip to header right navigation
  • Skip to site footer

My Online Training Hub

Learn Dashboards, Excel, Power BI, Power Query, Power Pivot

  • Courses
  • Pricing
    • Free Courses
    • Power BI Course
    • Excel Power Query Course
    • Power Pivot and DAX Course
    • Excel Dashboard Course
    • Excel PivotTable Course – Quick Start
    • Advanced Excel Formulas Course
    • Excel Expert Advanced Excel Training
    • Excel Tables Course
    • Excel, Word, Outlook
    • Financial Modelling Course
    • Excel PivotTable Course
    • Excel for Customer Service Professionals
    • Excel for Operations Management Course
    • Excel for Decision Making Under Uncertainty Course
    • Excel for Finance Course
    • Excel Analysis ToolPak Course
    • Multi-User Pricing
  • Resources
    • Free Downloads
    • Excel Functions Explained
    • Excel Formulas
    • Excel Add-ins
    • IF Function
      • Excel IF Statement Explained
      • Excel IF AND OR Functions
      • IF Formula Builder
    • Time & Dates in Excel
      • Excel Date & Time
      • Calculating Time in Excel
      • Excel Time Calculation Tricks
      • Excel Date and Time Formatting
    • Excel Keyboard Shortcuts
    • Excel Custom Number Format Guide
    • Pivot Tables Guide
    • VLOOKUP Guide
    • ALT Codes
    • Excel VBA & Macros
    • Excel User Forms
    • VBA String Functions
  • Members
    • Login
    • Password Reset
  • Blog
  • Excel Webinars
  • Excel Forum
    • Register as Forum Member

Transfer of data slow when pressing command button|VBA & Macros|Excel Forum|My Online Training Hub

You are here: Home / Transfer of data slow when pressing command button|VBA & Macros|Excel Forum|My Online Training Hub
Avatar
sp_LogInOut Log In sp_Registration Register
sp_Search Search
Advanced Search|Last Search Results
Search
Forum Scope




Match



Forum Options



Minimum search word length is 3 characters - maximum search word length is 84 characters
sp_Search Search
sp_RankInfo
Lost password?
sp_CrumbsHome HomeExcel ForumVBA & MacrosTransfer of data slow when pressing…
sp_PrintTopic sp_TopicIcon
Transfer of data slow when pressing command button
Avatar
Helen Warburton
Member
Members
Level 0
Forum Posts: 20
Member Since:
November 16, 2020
sp_UserOfflineSmall Offline
1
November 16, 2020 - 11:05 pm
sp_Permalink sp_Print

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.

sp_AnswersTopicSeeAnswer See Answer
Avatar
Philip Treacy
Admin
Level 10
Forum Posts: 1518
Member Since:
October 5, 2010
sp_UserOfflineSmall Offline
2
November 17, 2020 - 8:56 am
sp_Permalink sp_Print

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

Avatar
Warren Hall

New Member
Members
Level 0
Forum Posts: 2
Member Since:
November 17, 2020
sp_UserOfflineSmall Offline
3
November 17, 2020 - 11:09 am
sp_Permalink sp_Print

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.

Avatar
Catalin Bombea
Iasi, Romania
Admin
Level 10
Forum Posts: 1810
Member Since:
November 8, 2013
sp_UserOfflineSmall Offline
4
November 17, 2020 - 1:17 pm
sp_Permalink sp_Print

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.

Avatar
Helen Warburton
Member
Members
Level 0
Forum Posts: 20
Member Since:
November 16, 2020
sp_UserOfflineSmall Offline
5
November 18, 2020 - 2:40 am
sp_Permalink sp_Print

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.

Avatar
Catalin Bombea
Iasi, Romania
Admin
Level 10
Forum Posts: 1810
Member Since:
November 8, 2013
sp_UserOfflineSmall Offline
6
November 18, 2020 - 12:47 pm
sp_Permalink sp_Print sp_EditHistory

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

Avatar
Helen Warburton
Member
Members
Level 0
Forum Posts: 20
Member Since:
November 16, 2020
sp_UserOfflineSmall Offline
7
November 18, 2020 - 7:10 pm
sp_Permalink sp_Print

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.

Avatar
Catalin Bombea
Iasi, Romania
Admin
Level 10
Forum Posts: 1810
Member Since:
November 8, 2013
sp_UserOfflineSmall Offline
8
November 19, 2020 - 1:53 pm
sp_Permalink sp_Print sp_EditHistory

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.

Avatar
Helen Warburton
Member
Members
Level 0
Forum Posts: 20
Member Since:
November 16, 2020
sp_UserOfflineSmall Offline
9
November 19, 2020 - 9:55 pm
sp_Permalink sp_Print

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.

Avatar
Catalin Bombea
Iasi, Romania
Admin
Level 10
Forum Posts: 1810
Member Since:
November 8, 2013
sp_UserOfflineSmall Offline
10
November 20, 2020 - 1:30 pm
sp_Permalink sp_Print

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.

Avatar
Catalin Bombea
Iasi, Romania
Admin
Level 10
Forum Posts: 1810
Member Since:
November 8, 2013
sp_UserOfflineSmall Offline
11
November 20, 2020 - 2:59 pm
sp_Permalink sp_Print

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

sp_AnswersTopicAnswer
Answers Post
Avatar
Catalin Bombea
Iasi, Romania
Admin
Level 10
Forum Posts: 1810
Member Since:
November 8, 2013
sp_UserOfflineSmall Offline
12
November 20, 2020 - 3:04 pm
sp_Permalink sp_Print

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.

Avatar
Helen Warburton
Member
Members
Level 0
Forum Posts: 20
Member Since:
November 16, 2020
sp_UserOfflineSmall Offline
13
November 23, 2020 - 10:49 pm
sp_Permalink sp_Print

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!

sp_Feed
Go to top
Forum Timezone: Australia/Brisbane
Most Users Ever Online: 245
Currently Online: Richard West, Wesley Burchnall, Clayton Watson
Guest(s) 9
Currently Browsing this Page:
1 Guest(s)
Top Posters:
SunnyKow: 1432
Anders Sehlstedt: 871
Purfleet: 412
Frans Visser: 346
David_Ng: 306
lea cohen: 219
Jessica Stewart: 204
A.Maurizio: 202
Aye Mu: 201
jaryszek: 183
Newest Members:
Murat Hasanoglu
Brett Dryland
Saeed Aldousari
Bhuwan Devkota
Kathryn Patton
Maria Conatser
Jefferson Granemann
Glen Coulthard
Nikki Fox
Rachele Dickie
Forum Stats:
Groups: 3
Forums: 24
Topics: 6222
Posts: 27291

 

Member Stats:
Guest Posters: 49
Members: 31913
Moderators: 3
Admins: 4
Administrators: Mynda Treacy, Philip Treacy, Catalin Bombea, FT
Moderators: MOTH Support, Velouria, Riny van Eekelen
© Simple:Press —sp_Information

Sidebar

Blog Categories

  • Excel
  • Excel Charts
  • Excel Dashboard
  • Excel Formulas
  • Excel PivotTables
  • Excel Shortcuts
  • Excel VBA
  • General Tips
  • Online Training
  • Outlook
  • Power Apps
  • Power Automate
  • Power BI
  • Power Pivot
  • Power Query
microsoft mvp logo
trustpilot excellent rating
Secured by Sucuri Badge
MyOnlineTrainingHub on YouTube Mynda Treacy on Linked In Mynda Treacy on Instagram Mynda Treacy on Twitter Mynda Treacy on Pinterest MyOnlineTrainingHub on Facebook
 

Company

  • About My Online Training Hub
  • Disclosure Statement
  • Frequently Asked Questions
  • Guarantee
  • Privacy Policy
  • Terms & Conditions
  • Testimonials
  • Become an Affiliate

Support

  • Contact
  • Forum
  • Helpdesk - For Technical Issues

Copyright © 2023 · My Online Training Hub · All Rights Reserved. Microsoft and the Microsoft Office logo are trademarks or registered trademarks of Microsoft Corporation in the United States and/or other countries. Product names, logos, brands, and other trademarks featured or referred to within this website are the property of their respective trademark holders.