To duplicate a row
 

The indicated part of the following code needs to be modified in such a
way that the row of the double clicked cell is duplicated for editing.
There are no formulae involved. The new row is to be inserted directly
below the active cell.

Private Sub Worksheet_BeforeDoubleClick _
(ByVal Target As Range, Cancel As Boolean)
On Error GoTo err_handler
With Target
If Not Intersect(Target, Range("N2:N6")) Is Nothing Then
If Not IsEmpty(.Value) Then
ThisWorkbook.FollowHyperlink ThisWorkbook.Path _
& "\" & .Value
End If
End If
'------------------ This is the code of interest ------------------
If .Row 8 Then
Range(Cells(ActiveCell.Row, "A"), _
Cells(ActiveCell.Row, "Z")).Insert xlDown
Range("B" & ActiveCell.Row).Select
On Error GoTo 0
End If
'-----------------------------------------------------------------------------
End With
Exit Sub

err_handler:
MsgBox "An error has been made" & vbCrLf _
& "File name not recognised.", _
vbExclamation, "Error Notice"
End Sub


All suggestions gratefully received.

Geoff

To duplicate a row
 

Try:

Private Sub Worksheet_BeforeDoubleClick _
(ByVal Target As Range, Cancel As Boolean)
On Error GoTo err_handler
With Target
If Not Intersect(Target, Range("N2:N6")) Is Nothing Then
If Not IsEmpty(.Value) Then
ThisWorkbook.FollowHyperlink ThisWorkbook.Path _
& "\" & .Value
End If
End If

If .Row 8 Then
Rows(.Row).Copy
Cells(.Row + 1, 1).Insert shift:=xlDown
Application.CutCopyMode = False
Cancel = True
End If

End With
Exit Sub

err_handler:
MsgBox "An error has been made" & vbCrLf _
& "File name not recognised.", _
vbExclamation, "Error Notice"
End Sub

Hope this helps
Rowan

wrote:
The indicated part of the following code needs to be modified in such a
way that the row of the double clicked cell is duplicated for editing.
There are no formulae involved. The new row is to be inserted directly
below the active cell.

Private Sub Worksheet_BeforeDoubleClick _
(ByVal Target As Range, Cancel As Boolean)
On Error GoTo err_handler
With Target
If Not Intersect(Target, Range("N2:N6")) Is Nothing Then
If Not IsEmpty(.Value) Then
ThisWorkbook.FollowHyperlink ThisWorkbook.Path _
& "\" & .Value
End If
End If
'------------------ This is the code of interest ------------------
If .Row 8 Then
Range(Cells(ActiveCell.Row, "A"), _
Cells(ActiveCell.Row, "Z")).Insert xlDown
Range("B" & ActiveCell.Row).Select
On Error GoTo 0
End If
'-----------------------------------------------------------------------------
End With
Exit Sub

err_handler:
MsgBox "An error has been made" & vbCrLf _
& "File name not recognised.", _
vbExclamation, "Error Notice"
End Sub


All suggestions gratefully received.

Geoff

To duplicate a row
 

If .Row 8 Then
Cells(.Row,1).Resize(1,26).Offset(1,0).Insert Shift:=xlDown
Cells(.Row,1).Resize(1,26).Offset(1,0).Filldown
On Error GoTo 0
End If

--
Regards,
Tom Ogilvy


wrote in message
oups.com...
The indicated part of the following code needs to be modified in such a
way that the row of the double clicked cell is duplicated for editing.
There are no formulae involved. The new row is to be inserted directly
below the active cell.

Private Sub Worksheet_BeforeDoubleClick _
(ByVal Target As Range, Cancel As Boolean)
On Error GoTo err_handler
With Target
If Not Intersect(Target, Range("N2:N6")) Is Nothing Then
If Not IsEmpty(.Value) Then
ThisWorkbook.FollowHyperlink ThisWorkbook.Path _
& "\" & .Value
End If
End If
'------------------ This is the code of interest ------------------
If .Row 8 Then
Range(Cells(ActiveCell.Row, "A"), _
Cells(ActiveCell.Row, "Z")).Insert xlDown
Range("B" & ActiveCell.Row).Select
On Error GoTo 0
End If

'---------------------------------------------------------------------------
--
End With
Exit Sub

err_handler:
MsgBox "An error has been made" & vbCrLf _
& "File name not recognised.", _
vbExclamation, "Error Notice"
End Sub


All suggestions gratefully received.

Geoff

To duplicate a row
 

Thank you Rowan.... That works a treat....

Geoff

To duplicate a row
 

And Thank you Tom too.

That works a treat as well.

Geoff

To duplicate a row
 

You're welcome.

wrote:
Thank you Rowan.... That works a treat....

Geoff