I created a progress bar with a UserForm with a STOP button. This UserForm works well and executed while my scripts are running.
The issue is that I cannot move the userFom Window with the mouse or click on the STOP button when the macro is running.
I guess the CPU is used for executing the code and then the UserForm has "no time" to get user inputs/events.
How can I solve this issue ?
I appreciate your help :)
To tell Excel to leave the CPU-consuming code for a moment and handle events from the user you have to insert
DoEvents
in your code.
E.g. If you have a long for loop you can write DoEvents inside the for loop. So at every iteration Excel will handle user inputs.
We don't have a sample code from you, here it's mine.
Public Sub YourRoutine()
Dim row_i As Long
'CPU Time consuming loop
For row_i = 1 To 9999999
Cells(row_i,1).Value = "I'm row number" & vbCrLf & row_i & vbCrLf & "."
Next i
End Sub
With the above code Excel will not answer to user inputs until the Sub ends.
Adding DoEvents as below code Excel will answer to user inputs every time row_i grows.
Public Sub YourRoutine()
Dim row_i As Long
'CPU Time consuming loop
For row_i = 1 To 9999999
Cells(row_i,1).Value = "I'm row number" & vbCrLf & row_i & vbCrLf & "."
'Interrupt for events
DoEvents
Next i
End Sub
You may also want to do 10 steps and after those iterations listen for user inputs
Public Sub YourRoutine()
Dim row_i As Long
'CPU Time consuming loop
For row_i = 1 To 9999999
Cells(row_i,1).Value = "I'm row number" & vbCrLf & row_i & vbCrLf & "."
'Interrupt for events every 10 iterations
If row_i Mod 10 = 0 Then
DoEvents
End If
Next i
End Sub
If you don't have a loop but a generic long code put DoEvents in every point you want Excel to listen to user events
I'm working on a project in Excel using VBA. I'm getting sheets from other workbooks, which takes a little time. For a userfriendly perspective, I'd like to show a picture saying "Loading" while the application gets the different sheets.
My problem is that the picture doesn't show before the Sub has finished. I've tried troubleshooting this myself.
I've tried running the code to insert the picture in another Sub being called. I've tried adding "DoEvents". I've tried adding an application wait. I've tried "ActiveWindow.SmallScroll" and "Application.Calculate" all without any luck.
I cannot see why the picture wouldn't show when the code is run.
If I add a break point in the code, the picture shows when I'd like it. I'm out of ideas and hope you can help me.
This is a snip of my code:
Sheet1.Activate
Application.Goto Reference:=Range("a1"), Scroll:=True
PicLoad = "PicLoad"
Sheet1.Pictures.Insert(Pictures & PicLoad & ".jpg").Name = PicLoad & "_picture"
Sheet1.Pictures(PicLoad & "_picture").Width = Application.Width
Sheet1.Pictures(PicLoad & "_picture").Left = 0
Sheet1.Pictures(PicLoad & "_picture").Top = 0
Sheet1.Shapes(PicLoad & "_picture").Line.Visible = msoTrue
Sheet1.Shapes(PicLoad & "_picture").Line.ForeColor.ObjectThemeColor = msoThemeColorText1
Sheet1.Shapes(PicLoad & "_picture").Line.Weight = 1
If ThisWorkbook.Path = requiredPath Then
Application.Run "Module4.HideCal"
For Each ws In ThisWorkbook.Worksheets 'Sletter alle worksheets undtagen nummer 1
If ws.Index <> 1 Then
ws.Delete
End If
Next
thisName = ThisWorkbook.Name
Workbooks.Open (requiredPath & "\" & fileComponents & "*.xl??"), ReadOnly:=True, CorruptLoad:=xlRepairFile 'f?r componenter ind
fileComponents = ActiveWorkbook.Name
total = Workbooks(thisName).Worksheets.Count
Workbooks(fileComponents).Worksheets(1).Copy _
after:=Workbooks(thisName).Worksheets(total)
Workbooks(fileComponents).Close
*Continues getting worksheets from different workbooks..
The Module4.HideCal contains:
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Everything works exactly as it should. The only problem is that the picture doesn't show until the sub has finished. I'd like to show it before the If statement.
Best regards
Check your Application.ScreenUpdating - if it is False, then you have told Excel not to show this. You will need to tell Excel to redraw/update the screen!
One method that sometimes forces the screen to redraw is
Application.WindowState= Application.WindowState
You may, just to be safe, also want to toggle the Application.ScreenUpdating around this:
Appliction.ScreenUpdating=True
Application.WindowState= Application.WindowState
Application.ScreenUpdating = False
I have a workbook that is used to organize daily orders for many customers into one sheet. The information that is entered into this sheet is then used to generate invoices for the customers.
This workbook has worked without any bugs for several months. However, recently it has started throwing up an error. I do not recall changing any of the code that could have caused this bug.
I have tried to figure this out by myself however, I am running out of ideas, here are a few things that I have found out:
The error ALWAYS pops up on the 7th iteration of the loop below (i.e when x=27).
The error ONLY has a problem with the (CheckBox " & x + 10) checkbox. I have tried running the loop avoiding checking the value of that particular checkbox and it works for all other checkboxes.
I read on another post that it might be a problem with using the dreaded .Select. So I got rid of it from everywhere that it might have been used.
My code
With ThisWorkbook.Worksheets("Invoice")
For x = 21 To 35
If .Shapes("Check Box " & x + 10).ControlFormat.Value = 1 And .Shapes("Check Box " & x + 25).ControlFormat.Value = 1 Then
MsgBox "Please only select one from the options (Return OR Discount)"
Exit Sub
Else
End If
Next x
End With
From what I understand, this error comes up when the object that I am working with does not support a property that I am trying to work with. What I do not understand is why the same lines of code, work "for 90%" of the loop (i.e the same type of object does support that property for 90% of the loop) but then it does not for one object of the same type.
For completeness, the code below is used to re-insert the checkboxes every time the workbook is used. This is done as another process might delete entire rows in the workbook, messing up the functionality of the check-boxes. So this makes sure the checkbox with the right name is in the correct cell:
Sub CheckBoxes()
ThisWorkbook.Worksheets("Invoice").CheckBoxes.Delete
With ThisWorkbook.Worksheets("Invoice")
For x = 5 To 19
Set cb = .CheckBoxes.Add(.Cells(x, "J").Left, .Cells(x, "J").Top, 4, 10)
With cb
.Name = "Check Box " & x + 26
.Caption = ""
.Display3DShading = False
End With
Set cb2 = .CheckBoxes.Add(.Cells(x, "K").Left, .Cells(x, "K").Top, 4, 10)
With cb2
.Name = "Check Box " & x + 41
.Caption = ""
.Display3DShading = False
End With
Next x
End With
End Sub
Any help or guidance in the right direction would be greatly appreciated!
Update as of June 11, 2019: I still haven’t figured out why practically all of my delay happens in those two lines, but current status is that I put up with the delay. So far, I have about 6000 rows of data in the master document, and an import process takes about 20 seconds regardless of how many rows I import.
—
I have a "master document" and I import data from lots and lots of little documents all day long. I admit I'm not a super-genius here, and a lot of my coding habits come from doing it "old school" so there may be "Excel ways" that I don't know (but want to learn!).
The issue I'm seeing is how much time a data file import can take.
When I started the tool out, data imports took only a few seconds.
Now that I have about 3500 rows of data, data imports take about 15-20 seconds. It doesn't matter if I am importing one row or a hundred rows. I expect this to keep going up. By the time I get to 7000 rows or 10,000 rows, I expect it to become unbearable.
By using message boxes (remember: "old school"), I've been able to narrow the speed bottleneck down to two lines of code. Between "Step 1" and "Step 2" is about 30% of my delay, and between "Step 2" and "Step 3" is about 70% of my delay.
I've included the whole sub below to make sure I'm not missing something obvious, but I made sure to UNINDENT my message boxes so you can go r-i-g-h-t to the code I suspect. Also, I included the entire sub because usually one of the first responses is “can you show the whole sub so I have better context?”
Thank you kindly for any thoughts or suggestions you might have. :)
Private Sub Btn_ImportDataFiles_Click()
' Search the current worksheet and assign the next TransactionID
Dim TransactionCounter As Integer
Dim TransactionID As Long ' This is the next available Transaction ID
TransactionID = Application.WorksheetFunction.Max(Range("a:a")) + 1
' open the file and import the data
Dim customerBook As Workbook
Dim filter As String
Dim caption As String
Dim customerFilename As String
Dim customerWorkbook As Workbook
Dim targetWorkbook As Workbook
' make weak assumption that active workbook is the target
Set targetWorkbook = Application.ActiveWorkbook
' get the customer workbook
filter = "Text files (*.xlsx),*.xlsx"
caption = "Please Select an input file "
customerFilename = Application.GetOpenFilename(filter, , caption)
If customerFilename <> "False" Then
' If they have uploaded the file before, let them know.
' If they want to keep uploading it, no harm done,
' but no need to stupidly add data that is already present.
' Select the archive sheet
Sheets("Upload_Archive").Select
Dim FileNameHunt As String
Dim cell As Range
Dim ContinueUpload As Boolean
ContinueUpload = True
FileNameHunt = Mid(customerFilename, InStrRev(customerFilename, "\") + 1)
Columns("A:A").Select
Set cell = Selection.Find(what:=FileNameHunt, after:=ActiveCell, LookIn:=xlFormulas, lookat:=xlWhole, searchorder:=xlByRows, searchdirection:=xlNext, MatchCase:=False, searchformat:=False)
If cell Is Nothing Then ' Add the new filename to the archive
Sheets("Upload_Archive").Select
Rows(1).Insert shift:=xlDown
Range("a1:a1").Value = FileNameHunt
Sheets("MasterSheet").Select
Application.Cells.Font.Name = "Calibri Light"
Application.Cells.Font.Size = "8"
Application.Cells.Font.Bold = False
Else
response = MsgBox("This data file has previously been uploaded. " & vbCrLf & "Do you want to cancel this upload?" & vbCrLf & vbCrLf & "Pressing [yes] will cancel the process." & vbCrLf & "Pressing [no] will continue with the file upload" & vbCrLf & "and add the data to the tracking sheet.", vbYesNo)
If response = vbYes Then
ContinueUpload = False
Sheets("MasterSheet").Select
Exit Sub
End If
End If ' If cell Is Nothing Then...
If ContinueUpload = True Then
' Continue with data upload procedure
Sheets("MasterSheet").Select
Set customerWorkbook = Application.Workbooks.Open(customerFilename)
' Copy data from customer to target workbook
Dim targetSheet As Worksheet
Set targetSheet = targetWorkbook.Worksheets(1)
Dim sourceSheet As Worksheet
Set sourceSheet = customerWorkbook.Worksheets(1)
Dim ImportRecordCount As Integer
ImportRecordCount = sourceSheet.Range("B1")
Dim ReconciliationID As String
ReconciliationID = ""
If sourceSheet.Range("E3") = "Removed from Depot" Then ReconciliationID = "1"
MsgBox ("Step 1")
targetSheet.Range("A1").EntireRow.Offset(1).Resize(ImportRecordCount).Insert shift:=xlDown ' Add the blank rows
MsgBox ("Step 2")
targetSheet.Range("B2:AB" & ImportRecordCount + 1).Value = sourceSheet.Range("A3:AA" & ImportRecordCount + 2).Value ' Bring in the big pile of data
MsgBox ("Step 3")
targetSheet.Range("AJ2:AJ" & ImportRecordCount + 1).Value = ReconciliationID ' To help with reconciling shipments
targetSheet.Range("AK2:AK" & ImportRecordCount + 1).Value = ReconciliationID ' To help with deployment timing
'targetSheet.Range("AI2:AI" & ImportRecordCount + 1).Value = "=COUNTIFS($D:$D, D2, $F:$F, F2)" ' This is the helper formula for identifying duplicates (deprecated, but I'm saving the code)
For TransactionCounter = 2 To ImportRecordCount + 1 ' Create and add the new Transaction ID values
targetSheet.Range("a" & TransactionCounter) = TransactionID + ImportRecordCount - TransactionCounter + 1
Next
' Close customer workbook
customerWorkbook.Close
' Format the sheet properly
Application.Cells.Font.Name = "Calibri Light"
Application.Cells.Font.Size = "8"
Application.Cells.Font.Bold = False
Application.Range("1:1").Font.Size = "10"
Application.Range("1:1").Font.Bold = True
' Query the User -- delete the file?
If MsgBox("Delete the local client-generated data file?" & vbCrLf & vbCrLf & "(this will NOT affect your email)", vbYesNo, "Confirm") = vbYes Then
Kill customerFilename
' MsgBox ("File: " & vbCrLf & customerFilename & vbCrLf & "has been deleted.")
End If
End If ' If ContinueUpload = True Then
End If ' If customerFilename <> "False" Then
End Sub
edit
I edited your original question to highlight things I found as suspect. These are things I felt are worth pointing out to you. I shaved everything else out as to focus on these particular issue. Review them and do soem research to see if you can find yourself in a better situation.
MsgBox ("Step 2")
'Ive never moved large amounts of data using this method. Ive always just used arrays. I have moved smaller bits of data though.
' I suspect that this might take a moment if the data set is large. Again use arrays to grab the data and move it.
' Edward says “This step takes about 70% of my delay — even if bringing in only a single line of data.”
targetSheet.Range("B2:AB" & ImportRecordCount + 1).Value = sourceSheet.Range("A3:AA" & ImportRecordCount + 2).Value ' Bring in the big pile of data
MsgBox ("Step 3")
' this loop is probably your main culprit of your performance issue.
' Edward says “Nope, this flies by. It is not the issue at all. I have verified this already.”
' Learn how to construct an array of data on the fly and then learn how to dump the entire array to
' sheet using a simple method.
For TransactionCounter = 2 To ImportRecordCount + 1 ' Create and add the new Transaction ID values
targetSheet.Range("a" & TransactionCounter) = TransactionID + ImportRecordCount - TransactionCounter + 1
Next
It looks like you have a lot of good things going here. A few things that I saw that could potentially be changed to improve your performance.
First, between "Step 1" and "Step 2": In my experience, adding rows takes longer than using rows that already exist. It looks like you are basically "pushing" everything down to make room for the new data, such that the newly entered data is at the top and the oldest data is at the bottom. (Correct me if I am wrong on any of this.) If you were to simply add the data to the end of the sheet, you would probably see some performance improvements, although I don't know how big of an improvement it would be.
Second, between "Step 2" and "Step 3": I have found that using .Value2 as opposed to .Value can give you some performance improvements, and the larger the data the bigger the improvement. This has a down side - Value2 does not retain any of the formatting that might be present, meaning that the number type (date, accounting, etc) does not pull over correctly. If this is something that you do not need, then you can use Value2.
Finally, other methods: When I run extensive macros, I always try to do everything I can to get a performance boost. You can get slight boosts across the board by using tricks like turning off screen updating (Application.ScreenUpdating = False), just be sure to turn it back on at the end of the macro.
I hope that this helps you figure it out! If all else fails, you can do it once or twice by hand to remember how much faster it is using the macro! Haha. Good Luck!
Have you tried using .value2? In some scenarios it might bring you better performance. Check some performance comparatives here: https://fastexcel.wordpress.com/2011/11/30/text-vs-value-vs-value2-slow-text-and-how-to-avoid-it/
It's difficult seeing where's the issue without having access to the original sheets. Maybe the issue is with the data itself instead of your VBA code and sometimes you might need to clean your source data of the heavy stuff and then add it again if needed.
You could also look into doing some parts with Python but I guess that's out of the question if you don't want to add additional software layers to your solution.
Try adding this at the beginning and end of your script. Just be sure to set everything back to TRUE!!
Application.ScreenUpdating = False
Application.DisplayAlerts = False
...CODE HERE...
Application.ScreenUpdating = True
Application.DisplayAlerts = True
I have an issue with my excel. To begin with, I create worksheets dynamically based on some parameters and then I export the worksheets as PDF. So far everything is fine. Now, when I am done with worksheets and I don't need them anymore I want to delete them. When I run the code excel crashes, repairs and then restarts itself. I am wondering if anyone has any idea why this keeps happening. I also delete named ranges for each sheet just in case.
Btw, if I delete them manually everything is fine.
Here's the code
Application.DisplayAlerts = False
Dim theName As Name
Dim newSheet As Worksheet
For i = 1 To unitsQty
Set newSheet = ThisWorkbook.Worksheets("Project Info " & i)
For Each theName In Names
If (TypeOf theName.Parent Is Worksheet) And (newSheet.Name = theName.Parent.Name) Then
theName.Delete
End If
Next
Set newSheet = ThisWorkbook.Worksheets("System Spec " & i)
For Each theName In Names
If (TypeOf theName.Parent Is Worksheet) And (newSheet.Name = theName.Parent.Name) Then
theName.Delete
End If
Next
Next i
Dim myArray() As Variant
ReDim myArray(unitsQty * 2)
With Sheets("Tables")
For i = 1 To unitsQty
myArray(i - 1) = "Project Info " & i
Debug.Print myArray(i)
Next i
For i = 1 To unitsQty
myArray(i - 1 + unitsQty) = "System Spec " & i
Debug.Print myArray(i)
Next i
End With
ThisWorkbook.Sheets(myArray(0)).Select
ThisWorkbook.Sheets(myArray).Select
ThisWorkbook.Sheets(myArray((unitsQty * 2 - 1))).Activate
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
thanks for your help. So basically in the worksheets I had OLE Object and therefore every time I was trying to delete a worksheets I had "Can't enter break mode at this time" and when I clicked continue but excel was crashing.
Even when I tried to delete all objects from the worksheet before i deleted it, excel still crashing.
I couldn't find any solution in the web, but I found a workaround that it is working fine and gives the desired results. The workaround is to copy the worksheets to a temp workbook and do all the work there and when I am done, i am just closing the workbook without saving it of course. That keeps my original workbook tidied up.