Macro to insert rows based on user selection Options??

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.