VBA Code to Add Rows is slowing down

[JayB0730]

Hello,

For some reason, all of a sudden, the following code is slowing down where I am seeing the additional rows being added one by one whereas in the past, I would have the circle spin for a few seconds and all added rows would appear. I could really use some expertise in optimizing the code. TIA

Sub AddEntry()
'

'
    Dim i
    
    For i = 1 To 5
    
        Application.ScreenUpdating = False
        ActiveSheet.Unprotect
        Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlFormulas, LookAt:= _
            xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Activate
        ActiveSheet.Cells(ActiveCell.Row, 2).Offset(1).Select
        ActiveCell.EntireRow.Insert
        Rows(ActiveCell.Row).Select
        With Selection
            .Interior.Color = xlNone
            .Locked = False
        End With
        ActiveSheet.Cells(ActiveCell.Row, 1).Select
        Call rowData
        'ActiveSheet.Protect
        Application.ScreenUpdating = True
    Next i
End Sub

Sub rowData()

    ActiveCell.Offset(0, 1).Select
    ActiveSheet.CheckBoxes.Add(Selection.Left + (Selection.Width / 2) - 8, Selection.Top + (Selection.Height / 2) - 8.625, 24, 17.25).Select 'Void Checkbox
        With Selection
        .Characters.Text = ""
        .Value = xlOff
        .LinkedCell = ActiveCell.Offset(0, 8).Address
        .Display3DShading = False
        .Locked = True
        End With
    ActiveCell.Offset(0, 1).Select
    With Selection.Validation 'Transaction Code
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=Transcode"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
    ActiveCell.Offset(0, 1).Select 'Transaction Type
    ActiveCell.FormulaR1C1 = _
        "=IF(RC3="""","""",VLOOKUP(RC3,'Transaction Codes'!C[-3]:C[-2],2,FALSE))" 'Transaction Type
    Selection.Locked = True
    Selection.FormulaHidden = False
    ActiveCell.Offset(0, 2).Select 'Payment Debit
    ActiveCell.FormulaR1C1 = _
        "=IF(ISERROR(VLOOKUP(RC3,'Transaction Codes'!C[-5]:C[-2],4,FALSE)=""Y""),"""",IF(VLOOKUP(RC3,'Transaction Codes'!C[-5]:C[-2],4,FALSE)=""Y"","""",IF(VLOOKUP(RC3,'Transaction Codes'!C[-5]:C[-2],3,FALSE)=0,"""",VLOOKUP(RC3,'Transaction Codes'!C[-5]:C[-2],3,FALSE))))" 'Payment Debit
    Selection.NumberFormat = "0.00"
    ActiveCell.Offset(0, 1).Select 'Payment Credit
    ActiveCell.FormulaR1C1 = _
        "=IF(ISERROR(VLOOKUP(RC3,'Transaction Codes'!C[-6]:C[-3],4,FALSE)=""Y""),"""",IF(VLOOKUP(RC3,'Transaction Codes'!C[-6]:C[-3],4,FALSE)=""Y"",VLOOKUP(RC3,'Transaction Codes'!C[-6]:C[-3],3,FALSE),""""))" 'Payment Credit"
    Selection.NumberFormat = "0.00"
    ActiveCell.Offset(0, 1).Select 'Balance
    ActiveCell.FormulaR1C1 = _
        "=IF(COUNT(RC[-2],RC[-1])>1,""Entry Conflict"",IF(RC[-5]=""BB"",RC[-1],IF(AND(RC[-2]="""",RC[-1]=""""),"""",IF(RC[-2]="""",R[-1]C+RC[-1],R[-1]C-RC[-2]))))" 'Balance"
        Selection.NumberFormat = "0.00"
        Selection.Locked = True
        Selection.FormulaHidden = True
    ActiveCell.Offset(0, 3).Select 'Deposit Conflict
    ActiveCell.FormulaR1C1 = _
        "=IF(ISERROR(IF(AND(VLOOKUP(RC3,'Transaction Codes'!C[-10]:C[-7],3,FALSE)=""Y"",RC6>0),""Y"",""N"")),"""",IF(AND(VLOOKUP(RC3,'Transaction Codes'!C[-10]:C[-7],3,FALSE)=""Y"",RC6>0),""Y"",""N""))" 'Deposit Conflict
    ActiveSheet.Cells(ActiveCell.Row, 9).Select
    Selection.NumberFormat = "m/dd/yyyy"
    ActiveSheet.Cells(ActiveCell.Row, 1).Select
    Selection.NumberFormat = "m/dd/yyyy"
    Range(ActiveCell, ActiveCell.Offset(0, 8)).Select 'Cell Format
    Selection.HorizontalAlignment = xlCenter
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Range(Cells(8, 1), Cells(2000, 9)).Select
    With Selection.HorizontalAlignment = xlCenter
    End With
    Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlFormulas, LookAt:= _
    xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Activate
    ActiveSheet.Cells(ActiveCell.Row, 1).Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

 

[Jeffrey Mahoney]

A couple of things. Try using Application.Calculation = False at the beginning. Seems to me you could copy one of the rows above to get the formatting you want on the new row. A lot less code!

 

[johnnyL]

All of those Selections are not helping your speed either.

 

[johnnyL]

You may want to provide us some data that we can test.

 

[offthelip]

There are other things you can do , after the first time you have found the last row you know where you have just inserted the row, so you need to find it again, just keep a variable with the row number in it.
Second you are applying formatting one cell at a time which is very very slow. It is much better to save the row number of the first row you insert and you know the last row you insert then apply the formatting to each column over the range after you have finished the loop .

 

[JayB0730]

I appreciate all of the replies; however, I am not great at VBA. Did a lot of research and copy and pasted etc. Any help to rewrite efficiently is greatly appreciated!