Hi leonidas,

I have created something with Excel 2002:


Sub ResizeNamedRange(ByVal strNamedRange As String, ByVal intLines As
Integer)
'
Dim strSheet As String
Dim strRefersTo As String
Dim intPos As Integer
Dim lngRow As Long

strSheet = ActiveWorkbook.ActiveSheet.Name
strRefersTo = ActiveWorkbook.Names("Gebied1").RefersToRange.Addr ess
intPos = InStrRev(strRefersTo, "$")
lngRow = Mid(strRefersTo, intPos + 1) - 1
strRefersTo = Left$(strRefersTo, intPos) & CStr(lngRow)

ActiveWorkbook.Names.Add Name:="Gebied1", RefersTo:="=" & strSheet
& "!" & strRefersTo
End Sub

Sub InsertRow1()
Application.ScreenUpdating = False
ActiveCell.Offset(1, 0).EntireRow.Insert
ActiveCell.EntireRow.Copy ActiveCell.Offset(1, 0).EntireRow

Selection.Offset(1).EntireRow.SpecialCells(xlConst ants).ClearContents

If Not Intersect(ActiveCell, Range("RijenFundering")) Is Nothing
Then
ResizeNamedRange "RijenFundering", 1
ElseIf Not Intersect(ActiveCell, Range("RijenBeganeGrondvloer")) Is
Nothing Then
ResizeNamedRange "RijenBeganeGrondvloer", 1
ElseIf Not Intersect(ActiveCell, Range("RijenMetselwerkenMinPeil"))
Is Nothing Then
ResizeNamedRange "RijenMetselwerkenMinPeil", 1
ElseIf Not Intersect(ActiveCell,
Range("RijenBetonskeletBetonvloer")) Is Nothing Then
ResizeNamedRange "RijenBetonskeletBetonvloer", 1
ElseIf Not Intersect(ActiveCell, Range("RijenKZSWandBetonvloer"))
Is Nothing Then
ResizeNamedRange "RijenKZSWandBetonvloer", 1
ElseIf Not Intersect(ActiveCell,
Range("RijenPrefabBetonBuitenspouwblad")) Is Nothing Then
ResizeNamedRange "RijenPrefabBetonBuitenspouwblad", 1
ElseIf Not Intersect(ActiveCell, Range("RijenStaalconstructie")) Is
Nothing Then
ResizeNamedRange "RijenStaalconstructie", 1
ElseIf Not Intersect(ActiveCell, Range("RijenStaalwerk")) Is
Nothing Then
ResizeNamedRange "RijenStaalwerk", 1
ElseIf Not Intersect(ActiveCell, Range("RijenMetselwerken")) Is
Nothing Then
ResizeNamedRange "RijenMetselwerken", 1
ElseIf Not Intersect(ActiveCell,
Range("RijenGevelsluitendeElementen")) Is Nothing Then
ResizeNamedRange "RijenGevelsluitendeElementen", 1
ElseIf Not Intersect(ActiveCell, Range("RijenDakconstructie")) Is
Nothing Then
ResizeNamedRange "RijenDakconstructie", 1
ElseIf Not Intersect(ActiveCell, Range("RijenPrefabElementen")) Is
Nothing Then
ResizeNamedRange "RijenPrefabElementen", 1
ElseIf Not Intersect(ActiveCell, Range("RijenDiversen")) Is Nothing
Then
ResizeNamedRange "RijenDiversen", 1
End If
End Sub

Sub deleteRow1()
If Not Intersect(ActiveCell, Range("RijenFundering")) Is Nothing
Then
ResizeNamedRange "RijenFundering", -1
ElseIf Not Intersect(ActiveCell, Range("RijenBeganeGrondvloer")) Is
Nothing Then
ResizeNamedRange "RijenBeganeGrondvloer", -1
ElseIf Not Intersect(ActiveCell, Range("RijenMetselwerkenMinPeil"))
Is Nothing Then
ResizeNamedRange "RijenMetselwerkenMinPeil", -1
ElseIf Not Intersect(ActiveCell,
Range("RijenBetonskeletBetonvloer")) Is Nothing Then
ResizeNamedRange "RijenBetonskeletBetonvloer", -1
ElseIf Not Intersect(ActiveCell, Range("RijenKZSWandBetonvloer"))
Is Nothing Then
ResizeNamedRange "RijenKZSWandBetonvloer", -1
ElseIf Not Intersect(ActiveCell,
Range("RijenPrefabBetonBuitenspouwblad")) Is Nothing Then
ResizeNamedRange "RijenPrefabBetonBuitenspouwblad", -1
ElseIf Not Intersect(ActiveCell, Range("RijenStaalconstructie")) Is
Nothing Then
ResizeNamedRange "RijenStaalconstructie", -1
ElseIf Not Intersect(ActiveCell, Range("RijenStaalwerk")) Is
Nothing Then
ResizeNamedRange "RijenStaalwerk", -1
ElseIf Not Intersect(ActiveCell, Range("RijenMetselwerken")) Is
Nothing Then
ResizeNamedRange "RijenMetselwerken", -1
ElseIf Not Intersect(ActiveCell,
Range("RijenGevelsluitendeElementen")) Is Nothing Then
ResizeNamedRange "RijenGevelsluitendeElementen", -1
ElseIf Not Intersect(ActiveCell, Range("RijenDakconstructie")) Is
Nothing Then
ResizeNamedRange "RijenDakconstructie", -1
ElseIf Not Intersect(ActiveCell, Range("RijenPrefabElementen")) Is
Nothing Then
ResizeNamedRange "RijenPrefabElementen", -1
ElseIf Not Intersect(ActiveCell, Range("RijenDiversen")) Is Nothing
Then
ResizeNamedRange "RijenDiversen", -1
End If

Application.ScreenUpdating = False
ActiveCell.EntireRow.Delete


End Sub

HTH,


RadarEye
leonidas wrote:
Hi,

In Excel I have named ranges, for example rows 13:23 are a named range
called "RijenFundering". When I select a cell in row 23 and use the
macro below to insert a row, then the empty row will be row 24. That is
outside the named range.
I also have a macro (see the second one below) to delete a row, but
with this macro I cannot delete row 24, because it is outside the named
range. I tried something like Range("RijenFundering" + 1) but I get an
error then.
How should one of these macros be rewritten, so I am able to delete row
24?
Thank in advance for helping me!

Sub InsertRows()

If Intersect(ActiveCell, Union(Range("RijenFundering"), _
Range("RijenBeganeGrondvloer"), Range("RijenMetselwerkenMinPeil"), _
Range("RijenBetonskeletBetonvloer"), Range("RijenKZSWandBetonvloer"),
_
Range("RijenPrefabBetonBuitenspouwblad"),
Range("RijenStaalconstructie"), _
Range("RijenStaalwerk"), Range("RijenMetselwerken"), _
Range("RijenGevelsluitendeElementen"), Range("RijenDakconstructie"), _
Range("RijenPrefabElementen"), Range("RijenDiversen"))) Is Nothing
Then
MsgBox "U kunt hier geen rij invoegen"
Else
Call InsertRows1
End If

End Sub
Private Sub InsertRows1()

Application.ScreenUpdating = False
ActiveCell.Offset(1, 0).EntireRow.Insert
ActiveCell.EntireRow.Copy ActiveCell.Offset(1, 0).EntireRow
Selection.Offset(1).EntireRow.SpecialCells(xlConst ants).ClearContents

End Sub
--------------------------------------------------------------------------
Sub DeleteRows()

If Intersect(ActiveCell, Union(Range("RijenFundering"), _
Range("RijenBeganeGrondvloer"), Range("RijenMetselwerkenMinPeil"), _
Range("RijenBetonskeletBetonvloer"), Range("RijenKZSWandBetonvloer"),
_
Range("RijenPrefabBetonBuitenspouwblad"),
Range("RijenStaalconstructie"), _
Range("RijenStaalwerk"), Range("RijenMetselwerken"), _
Range("RijenGevelsluitendeElementen"), Range("RijenDakconstructie"), _
Range("RijenPrefabElementen"), Range("RijenDiversen"))) Is Nothing
Then
MsgBox "U kunt deze rij niet verwijderen"
Else
Call DeleteRows1
End If

End Sub
Private Sub DeleteRows1()

Application.ScreenUpdating = False
ActiveCell.EntireRow.Delete

End Sub


--
leonidas
------------------------------------------------------------------------
leonidas's Profile: http://www.excelforum.com/member.php...o&userid=35375
View this thread: http://www.excelforum.com/showthread...hreadid=555476