Macro to insert rows based on user selection

[Mike Magill]

I have a macro that allows a user to insert one or more rows based on
a user input box. This allows me to control which formulae get copied
into the new cells.

The macro works fine UNLESS the user scrolls around the screen before
making their selection. How can I resolve this?

This is the key part of the script.

Thanks,

Mike


Sub Row_Insertion()
'
' This macro inserts a user-specified number of rows
' and ensures that the relevant formulae are copied
' into the new rows.

Range("I3").Select ' Makes I3 the active cell and
Set rng = Nothing ' clears any selection made by the user

Application.ScreenUpdating = True ' Allows the screen to refresh
while the user is selecting a range

On Error Resume Next ' This prevents the macro from stopping if
an error occurs

'This Input Box requires the user to select the row(s) where they
want rows to be inserted

Set rng = Application.InputBox(prompt:="Select the row number(s)
at the point at which you wish to insert rows. " & vbNewLine &
vbNewLine & _
"Click on OK and the rows will be inserted " & _
"immediately above that point.", Title:="Inserting a row",
Type:=8)

Application.ScreenUpdating = False ' Stops the screen refreshing
while the macro is running

' If no range is selected by the user protect the worksheet and
end the macro

If rng Is Nothing Then
Range("i3").Select
Exit Sub

Else
End If

rng.Select ' select the range chosen by the user

If Not Intersect(ActiveCell, Range("A1:IV5")) Is Nothing Then '
Check to see if the user has selected in the
MsgBox "You cannot insert a row in this area!" '
header area (rows 1-6) and end macro if so.
Range("i3").Select
Exit Sub

Else

' If a valid selection has been made insert the appropriate number
of rows and then
' copy the relevant formulae into the inserted rows. The formulae
copying is done one column
' at a time. Hence the multiple copy/paste commands below.

Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromRightOrBelow

Selection.End(xlToLeft).Select
Selection.End(xlDown).Select
Selection.Copy
Range(Selection, Selection.End(xlUp).Offset(1, 0)).Select
ActiveSheet.Paste

etc.etc.