How do I select newly inserted rows?

Microsoft Excel 2003 (full product)
November 23, 2009 at 01:35:17
Specs: Windows XP
Here's what I want to do:

From:
A
B
C

I want it to become:
A
A (selected row)
B
B (selected row)
C
C (selected row)

How do I do this? Here is my draft code so far.


Sub GCHANG_AlternateRows()

'We turn off calculation and screenupdating to speed up the macro.
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False

Dim sSelectedRows As String
Dim nNextRow As Long

'We work backwards because we are adding rows.
For nCurrentRow = Selection.Rows.Count To 1 Step -1

nNextRow = nCurrentRow + 1
Selection.Rows(nCurrentRow).Offset(1, 0).Insert Shift:=xlDown
Selection.Rows(nCurrentRow).Copy Destination:=Selection.Rows(nCurrentRow).Offset(1, 0)

sSelectedRows = sSelectedRows & "A" & Selection.Rows(nCurrentRow).Offset(1, 0).Row & ","
MsgBox sSelectedRows
Next nCurrentRow

' Trim the last comma from our string
sSelectedRows = Mid(sSelectedRows, 1, Len(sSelectedRows) - 1)
Range(sSelectedRows).EntireRow.Select

.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With

End Sub


See More: How do I select newly inserted rows?

Report •


#1
November 23, 2009 at 05:24:59
Hi,

I think the following code does what you want, inserting new rows between existing rows in your selection (the initial selection must be rows).
Then it selects all the new rows.

I have not added any checks to ensure that the initial selection is valid, i.e., that it is a selection of rows.

I have not included the code to turn off screen updating or stopping automatic calculation. You can add that if required.

Option Explicit

Private Sub AlternateRows()
Dim lngRows As Long
Dim rngRow As Range
Dim strNewRows As String
Dim n As Integer

On Error GoTo ErrHnd

'get number of rows in the current selection
lngRows = Selection.Rows.Count

'set rngRow as the top row in the selection
Set rngRow = Selection.Rows(1)

'insert rows
For n = lngRows To 1 Step -1
    rngRow.Offset(n, 0).Insert Shift:=xlDown
Next n

'create selection address with all the new rows
'start with first new row
strNewRows = rngRow.Offset(1, 0).Address
'add remaining rows
For n = 3 To lngRows * 2 Step 2
    strNewRows = strNewRows & "," & rngRow.Offset(n, 0).Address
Next n

'select the new rows
Range(strNewRows).Select
Exit Sub

'error handler
ErrHnd:
Err.Clear
End Sub

If you want the new rows to be copies of the rows above, then use this extra line in the insert rows loop:

'insert rows
For n = lngRows To 1 Step -1
    rngRow.Offset(n, 0).Insert Shift:=xlDown
    rngRow.Offset(n - 1, 0).Copy Destination:=rngRow.Offset(n, 0)
Next n

Regards

Report •

#2
November 23, 2009 at 06:04:41
I have updated the code as below:
But it's not doesn't work right if the rows are not consecutive.
Further help will be appreciated. :)
---

Dim lngRows As Long
Dim rngRow As Range
Dim strNewRows As String
Dim n As Integer

On Error GoTo ErrHnd

'get number of rows in the current selection
lngRows = Selection.Rows.Count

'set rngRow as the top row in the selection
Set rngRow = Selection.Rows(1)

'insert rows
For n = lngRows To 1 Step -1
rngRow.Offset(n, 0).Insert Shift:=xlDown
Selection.Rows(n).Copy Destination:=Selection.Rows(n).Offset(1, 0)
Next n

'create selection address with all the new rows
'start with first new row
strNewRows = rngRow.Offset(1, 0).Address
'add remaining rows
For n = 3 To lngRows * 2 Step 2
strNewRows = strNewRows & "," & rngRow.Offset(n, 0).Address
Next n

'select the new rows
Range(strNewRows).EntireRow.Select
Exit Sub

'error handler
ErrHnd:
Err.Clear


Report •

#3
November 23, 2009 at 13:58:33
Hi,

Your original sample data indicated that there was a single selection, with alternate rows to be inserted. The code I provided will not work on multiple selections / non-contiguous rows.

Below is code using a different approach which works on multiple selections, but the selections must be complete rows. It will not work on single cell selections.

Option Explicit
Private Sub InsertRows()
Dim intAreas As Integer
Dim intRows As Integer
Dim rngRow As Range
Dim rngArea As Range
Dim lngRows As Long
Dim strAddrArry() As String
Dim strNewRows As String
Dim m, n, o, p As Integer

On Error GoTo ErrHnd

'get number of Areas in Selection
intAreas = Selection.Areas.Count

'get number of rows in selection
lngRows = 0
For Each rngArea In Selection.Areas()
    For Each rngRow In rngArea.Rows()
        lngRows = lngRows + 1
    Next rngRow
Next rngArea

'size an array to match number of rows in selection
ReDim strAddrArry(lngRows - 1)

'go through each area in the selection, add rows and copy
m = 0
n = 0
'start with last Area in selection
For m = intAreas To 1 Step -1
    intRows = Selection.Areas(m).Rows.Count
    'start with last row in area
    For o = intRows To 1 Step -1
        'set rngRow to a row
        Set rngRow = Selection.Areas(m).Rows(o)
        'insert row below selected row
        rngRow.Offset(1, 0).Insert shift:=xlDown
        'copy selected row to new row
        rngRow.Copy Destination:=rngRow.Offset(1, 0)
        'save address of new row in an array
        strAddrArry(n) = rngRow.Address
        'move references to lower rows
        For p = n To 0 Step -1
            strAddrArry(p) = Range(strAddrArry(p)).Offset(1, 0).Address
        Next p
        'increment inserted rows counter
        n = n + 1
    Next o
Next m

'create the selection address from the addresses saved in the array
strNewRows = strAddrArry(0)
For n = 1 To UBound(strAddrArry)
    strNewRows = strNewRows & "," & strAddrArry(n)
Next n

'select the new rows
Range(strNewRows).Select
Exit Sub

'error handler
ErrHnd:
Err.Clear
End Sub

Regards


Report •

Related Solutions

#4
November 24, 2009 at 04:49:27
Just what the doctor ordered.
Thanks so much! It does exactly what I want. :D

Report •

#5
November 24, 2009 at 05:25:56
You're welcome

Report •


Ask Question