Configuring Double Click

[geofferrington]

Hi there.
I am using 2002 and am having a small problem with the required syntax
of a "Target.Address" statement. The code that needs to be changed is
indicated at the bottom end of the following code.


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel
As Boolean)
On Error GoTo err_handler
If Target.Address = "$F$2" Then
ActiveWorkbook.FollowHyperlink ThisWorkbook.Path & "\" &
Range("F2").Value
Cancel = True
End If
If Target.Address = "$F$3" Then
ActiveWorkbook.FollowHyperlink ThisWorkbook.Path & "\" &
Range("F3").Value
Cancel = True
End If
If Target.Address = "$F$4" Then
ActiveWorkbook.FollowHyperlink ThisWorkbook.Path & "\" &
Range("F4").Value
Cancel = True
End If
If Target.Address = "$F$5" Then
ActiveWorkbook.FollowHyperlink ThisWorkbook.Path & "\" &
Range("F5").Value
Cancel = True
End If
If Target.Address = "$F$6" Then
ActiveWorkbook.FollowHyperlink ThisWorkbook.Path & "\" &
Range("F6").Value
Cancel = True
End If
If Target.Address = "$F$7" Then
ActiveWorkbook.FollowHyperlink ThisWorkbook.Path & "\" &
Range("F7").Value
Cancel = True
End If
If Target.Address = "$F$8" Then
ActiveWorkbook.FollowHyperlink ThisWorkbook.Path & "\" &
Range("F8").Value
Cancel = True
End If
'-------------------------------------------------------------
If Target.Address > row 11 Then 'Could I have the correct expression
for "row 11" please
Cancel = True
Target.Offset(1).EntireRow.Insert
Target.EntireRow.Copy Target.Offset(1).EntireRow
Target.Offset(1).EntireRow.SpecialCells(xlConstants).ClearContents
End If
'-------------------------------------------------------------
Exit Sub
err_handler:
MsgBox "An error has been made" & vbCrLf & "File name not recognised.",
_
vbExclamation, "Error Notice"
End Sub


Hopefully this code will indicate what I am trying to achieve here, so
any input on how I can make this code more efficient would be greatly
appreciated.

Also. that code between the dashed lines works well at inserting a new
line, but I now require it to just move all the data in columns B,C,D
and E down one line and insert a space in each new cell. There are no
formulae in these areas. I wish to do it this way because I do not want
the eventual user to be troubled with removing the error tabs created
by a formula in column A.

BTW. for anyone who is interested... Inserting the spaces into empty
cells is the technique I use to avoid coding repetitive "VLOOKUPs" in
an "IF" statement in order to stop that "0" being placed in there.

Any assistance is greatly appreciated

Geoff

 

[Norman Jones]

Hi Geoff,

Your code could be simplified to:

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

If .Row > 11 Then
Cancel = True
.Offset(1).EntireRow.Insert
.EntireRow.Copy .Offset(1).EntireRow
On Error Resume Next 'In case no constants found!
.Offset(1).EntireRow.SpecialCells(xlConstants). _
ClearContents
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
'<<===============

With reference to:

If Target.Address > row 11 Then 'Could I have the correct expression
for "row 11" please
Cancel = True
Target.Offset(1).EntireRow.Insert
Target.EntireRow.Copy Target.Offset(1).EntireRow
Target.Offset(1).EntireRow.SpecialCells(xlConstants).ClearContents
End If

I did not immediately understand the descibed scenario to which this code
snippet relates. I have therefore simply revised the syntax and added error
handling to allow for the possible absence of constant values.

 

[geofferrington]

Thankyou very much Norman.. With the exception of that part about
inserting cells below the selected cell it works perfectly.

On that last matter the fault was mine for not being clear... so I will
have another attempt.

starting at row 12 I have built in a structure to house 1,000 records.
There are formulae in columns A, G and I
and Data is entered in B, C, D and E.
The formulae are fixed and to be locked and they reflect the values in
the data entry cells.
So when a user wants to insert data between two existing rows there is
a need to shift all the data below the selected cell down one line.

I would envisage a routine that establishes a range from $B$(selected
row number +1) : $E$(last used cell in column B)
this range would then drop down a nominated number of lines. (probably
1 would be fine)
Note: only the data moves... Not the formulae.

Hope I have been clearer this time.

Geoff

 

[Norman Jones]

Hi Geoff,

If you move (say) B13:E13 down a row, the formulae in row 13 will adjust to
reflect this move and will then point to cells B14:E14.

I do not know your data configuration, but are you sure that you do not want
to insert a new row in the range Ax:Ix, the new row having formulae in Ax
and Gx:Ix which point to empty data cells in the range Bx:Ex. Otherwise
expressed, insert a new row with formulae but no data?

Either scenario is achievable, I merely wish to verify the intent.

 

[geofferrington]

Norman

What I am trying to achieve is a macro that selects all the data in
colmns B,C,D and E, below the row where the "Cursor" is, and move it
all down 1 row.

Much the same as we do manually when we make a selection and then drag
just that selection to somewhere else on a sheet.

I need to do this because XL has problems (or, more likely, myself)
inserting a row in a locked (protected) environment.

I will write a separate routine for inserting spaces later. That part
is not very important at the moment.

Norman you are a very patient man.

Geoff

 

[Norman Jones]

Hi Geoff,

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

If .Row > 12 Then
Cancel = True
.EntireRow.Insert
.EntireRow.Copy .Offset(-1).EntireRow
On Error Resume Next 'In case no constants found!
.Offset(-1).EntireRow.SpecialCells(xlConstants). _
ClearContents
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
<<===============

 

[geofferrington]

Thank you very much for your time Norman.

I have decided to go with your original suggestion and move the
critical formula to another sheet. That way there are no formulae
corruptions. It seems that if you are going to protect a spreadsheet
then it is a good idea, as a rule, not to have data entry on the same
sheet as the formulae that process that data.

Your assistance and patience has been most appreciated.

Geoff