I have code like the following:
Sub RMS()
Application.Calculation = xlCalculationManual
Sheets("m1").Range("A3").FormulaR1C1 = "=LEN(LEFT(m!R[2]C,FIND(""x"",m!R[2]C & "","")-1))"
Range("A1:A3").Select
Selection.AutoFill Destination:=Range("A1:EZ3"), Type:=xlFillDefault
Range("A1:EZ3").Select
Selection.AutoFill Destination:=Range("A1:EZ600"), Type:=xlFillDefault
Range("A1:EZ600").Select
End Sub
This code is running very slow. Is there any help you can give so that code like this could run much faster because I run this code in multiple sheets?
This will be faster :
Sub RMS()
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
With Sheets("m1")
.Range("A3").FormulaR1C1 = "=LEN(LEFT(m!R[2]C,FIND(""x"",m!R[2]C & "","")-1))"
.Range("A1:A3").AutoFill Destination:=.Range("A1:EZ3"), Type:=xlFillDefault
.Range("A1:EZ3").AutoFill Destination:=.Range("A1:EZ600"), Type:=xlFillDefault
End With
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub
Related
I made a small vba script in order to turn on or off screenupdating and calculation automatic.
here is my code:
Sub speed_up()
If Application.Calculation = xlAutomatic Then
Application.ScreenUpdating = False
Application.Calculation = -4135
Else
Application.ScreenUpdating = True
Application.Calculation = -4105
End If
End Sub
Regarding calculation, it's working well.
In my immediate window, when I ask
?Application.ScreenUpdating
I always get
True
Is it normal? shouldn't I get false and True alternatively?
What is the correct code in order for the workbook to save to the referenced file path in cell B19? The file path looks like this C:Desktop\ExcelFiles\Data Table.xlsb
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
End With
ThisWorkbook.SaveAs Filename:=Sheets("Sheet1").Range("B19").Value
'^^^Need help understanding the correct syntax of this line ^^^
This worked for me.
Sub SaveMe()
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
End With
ThisWorkbook.SaveAs Filename:=Sheets("Sheet1").Range("B19").Value, _
FileFormat:=xlExcel12, CreateBackup:=False
End Sub
Basically,just turn on the Macro Recorder and modify the code, slightly, to suit your needs.
I've been researching how to speed up my code in Excel VBA and I've come across the following settings which have been helpful. My question is: is it possible to set the following lines of code into one variable that I can set to On or Off to activate the entire list? I.e. something like
speedUpCode = On
would set all of the below settings and if it were set to Off it would reverse all of the below to True/xlCalculationAutomatic
With Application
.ScreenUpdating = False
.DisplayStatusBar = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
ActiveSheet.DisplayPageBreaks = False 'note this is a sheet-level setting
I use this (very basic):
Sub GoFast(Optional bYesNo As Boolean = True)
With Application
.ScreenUpdating = Not bYesNo
.Calculation = IIf(bYesNo, xlCalculationManual, xlCalculationAutomatic)
End With
End Sub
Call with True or no parameter to speed things up, then with False to reset.
The comments above about about possibly capturing the current state of the various settings so you can get back to the "original" state, and that not all settings are always appropriate to update depending on exactly what you're doing are all worth considering.
You can use a function to do this like so ...
Function speedUpCode(sStatus As String)
If sStatus = "On" Then
With Application
.ScreenUpdating = False
.DisplayStatusBar = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
ActiveSheet.DisplayPageBreaks = False 'note this is a sheet-level setting
Else if sStatus = "Off" then
With Application
.ScreenUpdating = True
.DisplayStatusBar = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
ActiveSheet.DisplayPageBreaks = True 'note this is a sheet-level setting
End Function
you can then use these to turn on and off
speedUpCode "On"
speedUpCode "Off"
However, keep in mind that you are turning settings on and off - you should probably check the status of these before changing them so that you can reset them to the original setting rather then just turning them all off again
you could does this with static variables
we used this VBA code mainly to hide blank rows & unhide non-blank rows, after that the second code sort the rows by a defined column value once the worksheet activated. This process take too much time with this code, could any one help me optimize this code and make it faster? (the worksheet contain an average of 500 rows).
Private Sub Worksheet_Activate()
HideRows
Sortingrisk
End Sub
Sub HideRows()
Dim rRange As Range, rCell As Range
Dim strVal As String
Set rRange = Worksheets(12).Range("A10:A500")
For Each rCell In rRange
strVal = rCell
rCell.EntireRow.Hidden = strVal = vbNullString
Next rCell
End Sub
Sub Sortingrisk()
ActiveWorkbook.Worksheets("Control Implementation Plan").AutoFilter.Sort. _
SortFields.Clear
ActiveWorkbook.Worksheets("Control Implementation Plan").AutoFilter.Sort. _
SortFields.Add Key:=Range("G10:G1000"), SortOn:=xlSortOnValues, Order:= _
xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Control Implementation Plan").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
Insert this at the start of your Sub:
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
And this just before End Sub:
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Try this:
Worksheets(12).Range("A10:A500").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
Your HiddenRows take an eternity. Try with
Sub HideRows()
Worksheets(12).Range("A10:A500").Hidden = True
End Sub
From a programming perspective, you should hide your entire range without using a loop. You can also optimize the run-time environment, with application properties being the first place to start.
Usually
Application.ScreenUpdating = False
is the most important line for speeding up a macro that's manipulating spreadsheet content.
Followed by
Application.Calculation = xlCalculationManual
which can be useful if your macro is triggering recalculation. I always hesitate to alter the calculation state from automatic though, since you risk leaving you spreadsheet in manual mode if the macro fails, and that can be very dangerous, especially if someone else who doesn't know about the macro is using it.
I would not disable DisplayStatusBar or EnableEvents. You stand very little to gain as far as speed and a lot to loose as far as functionality.
Here is an example of your code streamlined a little more and using a manual calculation state that will safely reset back to auto on a non-fatal error. You may want to consider removing the manual state or constructing additional error handling.
Private Sub Worksheet_Activate()
Application.ScreenUpdating = False
HideRows Me
SortingRisk Range("G10:G1000")
End Sub
Sub HideRows(ByRef w As Worksheet)
w.Range("A10:A500").Rows.Hidden = True
End Sub
Sub SortingRisk2(ByRef R As Range)
Application.Calculation = xlCalculationManual
On Error GoTo term
Dim F As AutoFilter
With R.Worksheet
If .AutoFilter Is Nothing Then
R.AutoFilter
End If
Set F = R.Worksheet.AutoFilter
F.Sort.SortFields.Clear
End With
With F.Sort
.SortFields.Add _
Key:=R, _
SortOn:=xlSortOnValues, _
Order:=xlDescending, _
DataOption:=xlSortNormal
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
term:
Application.Calculation = xlAutomatic
If Err > 0 Then
MsgBox "Error: Macro has terminated. Verify that Workbook Calculation
state is in auto."
End If
End Sub
this is my code for my Macro. What is does is copy a specific sheet to another workbook. My question is how to paste only values and the format must be read type only.
Sub NewReport()
Dim PRICE_REV_TEMPLATE As Workbook
Dim PRICE_REV_TEMPLATE_FC As Workbook
With Application
.ScreenUpdating = False
.DisplayAlerts = False
.EnableEvents = False
End With
Set PRICE_REV_TEMPLATE = ActiveWorkbook
Set PRICE_REV_TEMPLATE_FC = Application.Workbooks.Add(1)
PRICE_REV_TEMPLATE.Sheets(Array(PRICE_REV_TEMPLATE.Sheets(6).Name)).Copy _
Before:=PRICE_REV_TEMPLATE_FC.Sheets(1)
PRICE_REV_TEMPLATE_FC.SaveAs FileName:="C:\Users\A3RBJZZ\Desktop\PRICE_REV_TEMPLATE_FC"
PRICE_REV_TEMPLATE_FC.Close
With Application
.ScreenUpdating = True
.DisplayAlerts = True
.EnableEvents = True
End With
End Sub
Try this - Hope this Helps
Sub NewReport()
Dim PRICE_REV_TEMPLATE As Workbook
Dim PRICE_REV_TEMPLATE_FC As Workbook
With Application
.ScreenUpdating = False
.DisplayAlerts = False
.EnableEvents = False
End With
Set PRICE_REV_TEMPLATE = ActiveWorkbook
Set PRICE_REV_TEMPLATE_FC = Application.Workbooks.Add(1)
PRICE_REV_TEMPLATE.Sheets(Array(PRICE_REV_TEMPLATE.Sheets(1).Name)).Copy Before:=PRICE_REV_TEMPLATE_FC.Sheets(1)
'selecting all cells and pasting as only values
PRICE_REV_TEMPLATE_FC.ActiveSheet.Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
PRICE_REV_TEMPLATE_FC.ActiveSheet.Paste
Application.CutCopyMode = False
'Added the Readonlyrecommended attrib.
PRICE_REV_TEMPLATE_FC.SaveAs Filename:="C:\Users\A3RBJZZ\Desktop\PRICE_REV_TEMPLATE_FC", ReadOnlyRecommended:=True
PRICE_REV_TEMPLATE_FC.Close
With Application
.ScreenUpdating = True
.DisplayAlerts = True
.EnableEvents = True
End With
End Sub