Hi John,

If all you want to do is run a procedure if user manually inserted row(s)
all you really need is to trap the Row-Insert button's click event (XL2000
and later), but with an OnTime macro. Except there could be a problem if
user's insert fails, which it can for various reasons. Could maintain a
named cell low down and compare its previous and current row number.

Following attempts to return newly inserted rows by right clicking a row
header and insert button. It gets quite complicated if multiple areas of
rows are inserted, and even more so if user didn't select them in order from
top down.

This is probably overkill for your purposes but look at the button click and
include your own OnTime macro.

For testing newly inserted rows are coloured yellow -

Code in a normal module, ThisWorkBook and Class1

'''''' code in a normal module''''''''
'
' run SetBtnClick or switch sheets to get things going

Option Explicit
Dim cls As Class1
Public gRngRows() As Range
Public gsRowsAddr As String

Sub SetBtnClick()
If cls Is Nothing Then
Set cls = New Class1
Set cls.btn = CommandBars("Row").FindControl(ID:=3183)
'Debug.Print cls.btn.Caption '&Insert
End If

If TypeName(Selection) = "Range" Then
SetRows Selection
Else
ReDim gRngRows(0)
gsRowsAddr = ""
End If
End Sub

Sub SetRows(rTarget As Range)
Dim bEntrireRows As Boolean
Dim shtColCnt As Long, n As Long
Dim rng As Range

On Error GoTo errElse
shtColCnt = ActiveSheet.Columns.Count
For Each rng In rTarget.Areas
n = n + 1
bEntrireRows = rng.Columns.Count = shtColCnt
If Not bEntrireRows Then Exit For
Next

If bEntrireRows Then
gsRowsAddr = rng.Areas(1).Address

ReDim gRngRows(1 To n)
n = 0
For Each rng In Selection.Areas
n = n + 1
Set gRngRows(n) = rng.Offset(rng.Rows.Count)
' error if offset extends below sheet but can't insert rows
Next
End If

errElse:
If Err.Number Or Not bEntrireRows Then
ReDim gRngRows(0)
gsRowsAddr = ""
End If

End Sub

Sub GetNewRows()
Dim i As Long, n As Long
Dim rng As Range, rA As Range

Set rng = Selection
If gRngRows(1).Address < gsRowsAddr Then
ReDim ord(1 To rng.Areas.Count, 0 To 1) As Long
i = 0
For Each rA In rng.Areas
i = i + 1
ord(i, 0) = i
ord(i, 1) = rA.Row
Next

'need to sort selected multiareas from top down
BubbleSort1 ord

Cells.Interior.ColorIndex = xlNone
For i = 1 To UBound(ord)
With rng.Areas(ord(i, 0))
Debug.Print "rows inserted " & .Offset(n).Address(0, 0)
.Offset(n).Interior.ColorIndex = 6
n = n + .Rows.Count
End With
Next
End If

SetRows rng
End Sub

Function BubbleSort1(arr() As Long)
Dim tmp0 As Long, tmp1 As Long
Dim i As Long
Dim b As Boolean
Do
b = True
For i = LBound(arr) To UBound(arr) - 1
If arr(i, 1) arr(i + 1, 1) Then
b = False
tmp0 = arr(i, 0)
tmp1 = arr(i, 1)
arr(i, 0) = arr(i + 1, 0)
arr(i + 1, 0) = tmp0
arr(i, 1) = arr(i + 1, 1)
arr(i + 1, 1) = tmp1
End If
Next i
Loop While Not b
End Function
''''''''''''''''''end normal module code'''''''''''''''

'''''code in ThisWorbook module''''''''

Private Sub Workbook_SheetActivate(ByVal Sh As Object)

SetBtnClick
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, _
ByVal Target As Range)
SetRows Target
End Sub

'''''end ThisWorkbook code''''''''''''''

''''' code in Class1 ''''''
Public WithEvents btn As CommandBarButton

Private Sub btn_Click(ByVal Ctrl As Office.CommandBarButton, _
CancelDefault As Boolean)

Application.OnTime Now, "GetNewRows"
End Sub
'''''end Class1 code'''''''''

This does not cater for other ways rows can be inserted

Regards,
Peter T

"John" wrote in message
...
Hi,

I run a procedure in the Change Event, problem is, i only want this to
happen when a row is inserted. Is it possibe to trap when a row is
inserted
and then run the procedure?

Thanks

John