I'm pretty sure I gave you this "InsertBlankRows" utility some time
ago, but perhaps in a different context than indicated in the
procedure. I'm also almost certaing it was with the context of copying
template rows to a specified row position. Here's the generic routine I
use for inserting rows above or below the active cell...
Sub InsertBlankRows(Optional Position As String)
' Inserts a specified number of rows at the location specified.
' If the Position arg is not used then the default is ActiveCell.Row.
Dim vRows As Variant, lPos As Long
Const sMsg As String = "Enter the number of rows to insert."
'Evaluate user input
On Error Resume Next
vRows = InputBox(Prompt:=sMsg, Default:=1): If vRows = "" Then Exit
Sub '//user cancels
If Not Err = 0 Or Not IsNumeric(vRows) Or Not vRows >= 1 Then Exit
Sub
'Get the position to insert
lPos = ActiveCell.Row: If Position = "Below" Then lPos = lPos + 1
'Insert the rows
ActiveSheet.Cells(lPos, 1).Resize(vRows).Insert Shift:=xlDown
End Sub
...where the caller would hold the position in its 'Tag' property of the
menuitem. The usage is typically inserting above, below, or just
increase the rows at the bottom of a defined input area. Popup menu
choices are...
"Insert rows &Above here" (Tag="Above")
"Insert rows &Below here" (Tag="Below")
-------------------------
"Add &More rows" (Tag="Add")
...where all 3 menuitems fire the same OnAction and are redirected using
an If...Then construct and passing the Tag value for the 1st 2 choices.
Whether or not 'template' rows are inserted depends on the project, but
if so then the template row is copied and inserted. A typical example
of how I do this is...
Sub AddRows()
' Inserts a specified number of rows at the location specified in the
ActionControl.Tag property
Const sSource$ = "AddRows"
Dim vRowCount As Variant, lPos&
Const sMsg$ = "Enter the number of rows to insert."
'Evaluate user input
vRowCount = 1 '//the default
On Error Resume Next
vRowCount = InputBox(sMsg, gsAPP_NAME, Default:=1): If vRowCount = ""
Then Exit Sub '//user cancels
If Not Err = 0 Or Not IsNumeric(vRowCount) Then NotifyInvalidInput:
Exit Sub
'Determine the number of rows
Select Case vRowCount
Case Is >= 1: vRowCount = vRowCount
Case Else: NotifyInvalidInput: Exit Sub
End Select 'vRowCount
'Get the position to insert
Select Case CommandBars.ActionControl.Tag
Case "Above": lPos = ActiveCell.Row
Case "Below": lPos = ActiveCell.Row + 1
Case "Add": lPos = Cells(Range("InputArea").Rows.Count, 1).Row +
Range("Hdr_Row").Row
End Select
'Insert the rows
EnableFastCode sSource
ActiveSheet.Unprotect PWRD
With Range("BlankTransaction")
.EntireRow.Hidden = False: .Copy: Cells(lPos,
1).Resize(vRowCount).Insert Shift:=xlDown: .EntireRow.Hidden = True
End With
Application.CutCopyMode = False
'Reset the scroll area to include the new rows
SetupUI Wks:=ActiveSheet: EnableFastCode sSource, False: wsProtect
End Sub 'AddRows
...where template rows are hidden by default so they don't clutter the
UI workspace. These are located above the top visible row. In your
scenario you can go this way for simplicity in the "'Insert the rows"
section above...
'Insert the rows
With Rows(Range("NRCSelection").Value)
.EntireRow.Hidden = False: .Copy
Cells(lPos, 1).Resize(vRowCount).Insert Shift:=xlDown
.EntireRow.Hidden = True
End With
Application.CutCopyMode = False
...where I deleted the lines specific to my own program features. This
means you don't need to evaluate the contents of "NRCSelection" if
selection is by DV list!
Note that I use local scope defined names by default because they're
reusable on other sheets, and so is what I recommend for your ranges.
--
Garry
Free usenet access at
http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
