Macro to insert rows based on user selection

  • Follow


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.
0
Reply Mike 1/21/2010 11:48:46 AM

0 Replies
776 Views

(page loaded in 0.08 seconds)


Reply: