This code takes 10 seconds to run

[VBE313]

Sub AddRowForNew()                                                 
 Dim rngstart As Range
 Dim rng As Range
 Dim col As Range
 Dim l As Long, strCells As String
        ActiveSheet.Unprotect Password:="B28"
        Application.ScreenUpdating = False
        Application.EnableEvents = False
 Set rng = Application.Range("BOM")
 For Each col In rng.Columns
 Debug.Print col.Column
 Next col
  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
        ActiveCell.Select
        ActiveCell.Offset(2, 0).Select
        Rows(ActiveCell.Row).Select
        Selection.Copy
        ActiveCell.Offset(-2, 0).Select
        ActiveSheet.paste
        ActiveCell.Offset(-1, 0).Select
        Rows(ActiveCell.Row).Select
        Selection.Copy
        ActiveCell.Offset(2, 0).Select
        ActiveSheet.paste
        Rows(ActiveCell.Row).ClearContents
        Rows(ActiveCell.Row).Select
        l = ActiveCell.Row
        strCells = "F" & l
        Range(strCells).Select
         If ActiveCell.Column = 6 And ActiveCell.Row >= 8 Then
  With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
  End With
  With Selection.Interior
        ActiveCell.Interior.Color = RGB(255, 242, 204)
        ActiveCell.Font.Color = rgbBlack
  End With
        With Selection.Font
        Selection.Font.Bold = True
        Selection.Font.Italic = False
        .Name = "Arial"
        .Size = 8
        Selection.Value = UCase(Selection)
  End With
  With Selection
        Selection.Value = ""
        ActiveCell.Offset(0, 4).Value = ""
        ActiveCell.Offset(0, 6).Value = ""
        Selection.Offset(0, -4).Value = ""
        ActiveCell.Offset(0, -2).Interior.Color = RGB(255, 242, 204)
        ActiveCell.Offset(0, -4).Interior.Color = RGB(255, 242, 204)
        ActiveCell.Offset(0, -4).Font.Name = "Arial"
        ActiveCell.Offset(0, -4).Font.Size = 8
        ActiveCell.Offset(0, -4).Font.Color = rgbBlack
  End With
 Else
        MsgBox "Not in Column F"
 End If
        ActiveSheet.Protect Password:="B28"
        ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
      , AllowFormattingColumns:=True
      Application.ScreenUpdating = True
      Application.EnableEvents = True
End Sub

 

[Fluff]

Do you actually have a question?

 

[FracinDean]

Doing row formatting one row at a time can be slow. I am struggling with a similar issue in one of my workbooks. If you can select all the rows you want to format at the same time and then reformat them at the same time, that could help.

I noticed a lot of copy paste operations that are one cell at a time also. If you can define a range name for those cells and then just copy and paste that range name, maybe that would help.

Good luck.

 

[Fluff]

Cross posted http://www.vbaexpress.com/forum/sho...-Any-suggestions-on-how-to-get-that-down-to-3

While we do not prohibit Cross-Posting on this site, we do ask that you please mention you are doing so and provide links in each of the threads pointing to the other thread (see rule 13 here along with the explanation: Forum Rules).
This way, other members can see what has already been done in regards to a question, and do not waste time working on a question that may already be answered.