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

Code:

---

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

---

Also posted here https://www.mrexcel.com/forum/excel-...conds-run.html

Too much unnecessary code.
for example:

Code:

---

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:

Code:

---

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

---

Code:

---

Sub M_snb()
    ActiveCell.EntireRow.Insert
End Sub

---

or

Code:

---

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

---

Bet generally activecell should be avoided like select & activate

re crossposting, please read: http://www.excelguru.ca/content.php?184

Try

Code:

---

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

---