Hi,
I have some very basic vba code in my spreadsheet which basically finds the first blank row, inserts a new row, adds an incremental number to column A then copies the formulas down from the row above.
It works fine, but the problem is it is very very slow. The spreadsheet is about 1200 rows, and growing.
Any suggestions on how to speed it up?
Thanks for your help:
Sub NewAsset()
'Add new line for new asset macro
Application.ScreenUpdating = False
Call ShowDetail
'find next empty row
ActiveWorkbook.Sheets("New Asset Register 11-12").Activate
Range("A5").Select
Do
If IsEmpty(ActiveCell) = False Then
ActiveCell.Offset(1, 0).Select
End If
Loop Until IsEmpty(ActiveCell) = True
'copy formulas down from above row
ActiveWorkbook.Sheets("New Asset Register 11-12").Unprotect
ActiveCell.EntireRow.Insert
ActiveCell.Offset(-1, 0).EntireRow.Copy
ActiveCell.EntireRow.PasteSpecial xlPasteFormulas
Application.CutCopyMode = False
ActiveCell.Activate
ActiveCell.Value = ActiveCell.Offset(-1, 0) + 1
Application.ScreenUpdating = True
ActiveCell.Select
End Sub
I have some very basic vba code in my spreadsheet which basically finds the first blank row, inserts a new row, adds an incremental number to column A then copies the formulas down from the row above.
It works fine, but the problem is it is very very slow. The spreadsheet is about 1200 rows, and growing.
Any suggestions on how to speed it up?
Thanks for your help:
Sub NewAsset()
'Add new line for new asset macro
Application.ScreenUpdating = False
Call ShowDetail
'find next empty row
ActiveWorkbook.Sheets("New Asset Register 11-12").Activate
Range("A5").Select
Do
If IsEmpty(ActiveCell) = False Then
ActiveCell.Offset(1, 0).Select
End If
Loop Until IsEmpty(ActiveCell) = True
'copy formulas down from above row
ActiveWorkbook.Sheets("New Asset Register 11-12").Unprotect
ActiveCell.EntireRow.Insert
ActiveCell.Offset(-1, 0).EntireRow.Copy
ActiveCell.EntireRow.PasteSpecial xlPasteFormulas
Application.CutCopyMode = False
ActiveCell.Activate
ActiveCell.Value = ActiveCell.Offset(-1, 0) + 1
Application.ScreenUpdating = True
ActiveCell.Select
End Sub