PDA

View Full Version : This code takes 5 seconds to run. Any suggestions on how to get that down to 3?



VBE313
04-04-2019, 08:42 AM
Dim rngstart As Range
Dim l As Long, strCells As String
ActiveSheet.Unprotect Password:="B28"
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
pagebreakstate = ActiveSheet.DisplayPageBreaks
ActiveSheet.DisplayPageBreaks = False
Set rngstart = ActiveCell
l = ActiveCell.Row
strCells = "F" & l
Range(strCells).Select
Rows(ActiveCell.Row).Select
Rows(ActiveCell.Row).Offset(1, 0).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ActiveCell.RowHeight = 13.5
Rows(ActiveCell.Row).Offset(1, 0).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Offset(-1, 0).Select
ActiveCell.RowHeight = 5
Rows(ActiveCell.Row).Interior.ColorIndex = 0
Rows(ActiveCell.Row).Locked = True
ActiveCell.Offset(-1, 0).Select
Rows(ActiveCell.Row).Select
Selection.Copy
ActiveCell.Offset(2, 0).Select
ActiveSheet.paste
Rows(ActiveCell.Row).Select
Range(strCells).Select
ActiveCell.Offset(2, 0).Select
Rows(ActiveCell.Row).ClearContents
ActiveCell.Interior.ColorIndex = 8
ActiveCell.Offset(0, -2).Interior.ColorIndex = 8
ActiveCell.Offset(0, -4).Interior.ColorIndex = 8
ActiveSheet.Protect Password:="B28"
ActiveSheet.Protect AllowFormattingColumns:=True
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
ActiveSheet.DisplayPageBreaks = pagebreakstate

Fluff
04-04-2019, 12:47 PM
Also posted here https://www.mrexcel.com/forum/excel-questions/1093311-code-takes-10-seconds-run.html

大灰狼1976
04-04-2019, 08:49 PM
Too much unnecessary code.
for example:

l = ActiveCell.Row
strCells = "F" & l
Range(strCells).Select
Rows(ActiveCell.Row).Select
Rows(ActiveCell.Row).Offset(1, 0).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Can be simplified to the following style:

l = ActiveCell.Row
Rows(l+1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

snb
04-05-2019, 03:01 AM
Sub M_snb()
ActiveCell.EntireRow.Insert
End Sub

or

Sub M_snb()
ActiveCell.offset(1).EntireRow.Insert
End Sub

Bet generally activecell should be avoided like select & activate

p45cal
04-05-2019, 04:35 AM
re crossposting, please read: http://www.excelguru.ca/content.php?184

Try
Dim pagebreakstate
ActiveSheet.Unprotect Password:="B28"
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
pagebreakstate = ActiveSheet.DisplayPageBreaks
ActiveSheet.DisplayPageBreaks = False

With ActiveCell.EntireRow
.Offset(1).Resize(2).Insert
.Offset(1).RowHeight = 5
.Offset(1).Interior.ColorIndex = 0
.Offset(1).Locked = True
.Copy .Offset(2)
With .Offset(2)
.ClearContents
.Range("B1,D1,F1").Interior.ColorIndex = 8
End With
End With

ActiveSheet.Protect Password:="B28", AllowFormattingColumns:=True
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
ActiveSheet.DisplayPageBreaks = pagebreakstate