automatically insert a row below the one that's being edited

[Phil Platt]

Hi all,

I'm sure this has been asked before but I cant't find it!

What I need is this:

A spreadsheet has a number of rows of data, separated by blank rows.
If a user enters data into one of the blank rows, I need a macro that
will automatically add a new blank row beneath.

I know it's a worksheet event, but it's really late right now and I
can't get my head around it - any help would be really appreciated!

Thanks in advance,

Phil

 

[Jim Cone]

Hi Phil,

Only very limited testing on the following code...
'Note that you can reset the whole thing by running
'the GetBlankRowNumbers sub.

'-----------------------------
'In the ThisWorkbook module use...

Private Sub Workbook_Open()
GetBlankRowNumbers
End Sub

'-----------------------------
'In a general module use...
'Change "Sheet1"to the correct sheet name.

Public arrRowNums() As Long ' This separate line goes at the top of the module.

Sub GetBlankRowNumbers()
Dim objRow As Excel.Range
Dim objRange As Excel.Range

With Worksheets("Sheet1")
Set objRange = .Range(Rows(1), .Rows(.UsedRange.Rows.Count).Row)
End With
ReDim arrRowNums(1 To objRange.Rows.Count)

For Each objRow In objRange.Rows
If WorksheetFunction.CountA(objRow) = 0 Then
arrRowNums(objRow.Row) = objRow.Row
End If
Next 'objRow

Set objRow = Nothing
Set objRange = Nothing
End Sub
'-----------------------------

'In the code module for your sheet use...

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim lngNum As Long
If UBound(arrRowNums) >= Target.Row Then
If arrRowNums(Target.Row) = Target.Row Then
Rows(Target.Row + 1).Insert shift:=xlDown
End If
End If
GetBlankRowNumbers 'Runs it again to square things away
End Sub
'-----------------------------

Regards,
Jim Cone
San Francisco, CA

 

[Jim Cone]

Phil,

Left something out when I cleaned up the code.
The Set objRange line should read...

Set objRange = .Range(.Rows(1), _
.Rows(.UsedRange.Rows(.UsedRange.Rows.Count).Row))

Also, in the Worksheet Change code - "Dim lngNum As Long" is not needed.

Regards,
Jim Cone
San Francisco, CA

-snip-