So at work I am working on a macro/UserForm in Excel for someone. It works great (I think) and does exactly what it needs to do and takes under 1 minute to run, going through ~70k cells and organizing them. Now I was wondering if there was a way to slow it down so that Excel does not go into "Not Responding" mode while it runs. It would just be better so people that need to use the macro don't freak out when it freezes. And it would be best if there was a solution in VBA so people don't have to worry about it and it works perfectly the first time.
About the Macro
The data is a bunch of numbers that need to be put in one column, and that the 14 (normally 14) columns before it label each number with dates and other data. All size references and sheet names needs to be from a UserForm so I don't know the name of the sheets or size ahead of time this resulted in some weird code at the beginning of my loop.
Also, if you see anyway to make my code more efficient that would be greatly appreciated!
The Code
Private Sub UserForm_Initialize()
'This brings up the data for my dropdown menu to pick a sheet to pull data from
For i = 1 To Sheets.Count
combo.AddItem Sheets(i).name
Next i
End Sub
Private Sub OK_Click()
Unload AutoPivotusrfrm
'Declaring All of my Variables that are pulled from Userform
Dim place As Long
Dim x1 As Integer
x1 = value1.Value
Dim x2 As Integer
x2 = value2.Value
Dim x3 As Integer
x3 = value4.Value
Dim y1 As Integer
y1 = value3.Value
Dim copyRange As Variant
Dim oldname As String
oldsheetname = combo.Text
Dim newname As String
newname = newsheetname.Text
Sheets.Add.name = newsheetname
'Labels for section one
Worksheets(CStr(oldsheetname)).Activate
copyRange = Range(Cells(x1, x1), Cells(x1 + 1, x3 - 1)).Value
Worksheets(CStr(newsheetname)).Activate
Range(Cells(x1, x1), Cells(x1 + 1, x3 - 1)).Value = copyRange
place = x1 + 2
x1 = place
'Looping through the cells copying data
For i = x1 To x2
'This was the only way to copy multiple cells at once other ways it would just error
Worksheets(CStr(oldsheetname)).Activate
copyRange = Range(Cells(i + 3 - x1, x1 - 2), Cells(i + 3 - x1, x3 - 1)).Value
Worksheets(CStr(newsheetname)).Activate
For j = x3 To y1
Range(Cells(place, 1), Cells(place, x3 - 1)).Value = copyRange
Cells(place, x3) = Sheets(CStr(oldsheetname)).Cells(1, j)
Cells(place, x3 + 1) = Sheets(CStr(oldsheetname)).Cells(2, j)
Cells(place, x3 + 2) = Sheets(CStr(oldsheetname)).Cells(i + 2, j)
place = place + 1
Next j
Next i
End Sub
Private Sub cancel_Click()
Unload AutoPivotusrfrm
End Sub
As @stuartd mentioned in the comments, DoEvents
will probably allow the user to interact with Excel while the macro is running, and prevent Excel from becoming unresponsive.
An alternative approach is to speed up your code, so that it finishes before the user has reason to believe that it has crashed. In this vein, here are some suggestions:
Turn off Screen Updating: It is a lot of work for Excel to render the screen. You can free those resources to work on what you need done by adding Application.ScreenUpdating = False
to the beginning of your code, and Application.ScreenUpdating = True
to the end.
Turn off Calculations: If you have a lot of formulas running, this can slow down what happens when you place a value into the workbook, as it needs to recalculoate. My preferred way of dealing with this is to store the current calculation setting, turn off calculations, and then restore the original setting at the end.
Dim Calc_Setting as Long
Calc_Setting = Application.Calculation
Application.Calculation = xlCalculationManual
'Your code here
Application.Calculation = Calc_Setting
Activate
or Select
. Fully reference you calls to Cells
, so that it accesses the right worksheet.Dim oldsheet as Worksheet, newsheet as Worksheet
Set oldsheet = Worksheets(CStr(oldsheetname))
Set newsheet = Worksheets(CStr(newsheetname))
oldsheet.Cells(place, x3) = ...
Dim inVal as Variant, Output as Variant
inVal = Range(oldsheet.Cells(1,x1-2),oldsheet.Cells(x2+3-x1,y)).Value
redim output(1 to (x2-x1) * (y-x3) + 2, 1 to x3+2)
'These numbers are not tested, you should test.
'Loops to fill output. This will need to be 1 entry at a time.
newsheet.Cells(x1,x1).Resize(Ubound(output,1), Ubound(output,2)).Value