Consulting

Results 1 to 5 of 5

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

Hybrid View

Previous Post Previous Post   Next Post Next Post
  1. #1
    VBAX Regular
    Joined
    Mar 2019
    Posts
    15
    Location

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

    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
    Last edited by Paul_Hossler; 04-04-2019 at 11:18 AM.

  2. #2

  3. #3
    VBAX Mentor 大灰狼1976's Avatar
    Joined
    Dec 2018
    Location
    SuZhou China
    Posts
    479
    Location
    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

  4. #4
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,635
    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

  5. #5
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    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
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •