specifying the column for double click

R

Rhino V

Thanks to the generous contriutors here, I have the following code which
copies data from one sheet to another:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As
Boolean)
Cancel = True ' prevent double-click from causing Edit Mode in cell
Application.Run "CopyProcedure"
End Sub

Sub CopyProcedure()
ActiveCell.Range("A1:E1").Select
Selection.Copy
Sheets("Report").Activate
mlastrow = Cells(Rows.Count, "A").End(xlUp).Row
Cells(mlastrow + 1, "A").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
End Sub

It works great except for one little thing: because it's supposed to copy
data from columns A to E of the same row when you double-click any cell in
coumn A, it also will copy the corresponding five adjacent cells no matter
where you double-click on the sheet.
How can I limit the code so that only when what is double-clicked is in
column A will the maco activate?
Thanx for any help anyone can provide on this.
 
P

Patrick Molloy

add this


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As
Boolean)

IF target.Column < 6 then

Cancel = True ' prevent double-click from causing Edit Mode in cell
Application.Run "CopyProcedure"

End IF

End Sub
 
J

Jacob Skaria

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As
Boolean)
If Target.Column = 1 then
Cancel = True ' prevent double-click from causing Edit Mode in cell
Application.Run "CopyProcedure"
End If
End Sub
 
R

Rick Rothstein

I think the following code will do what you want...

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
Cancel As Boolean)
If Target.Column = 1 Then
Cancel = True ' prevent double-click from causing Edit Mode in cell
CopyProcedure Target.Row
End If
End Sub

Sub CopyProcedure(TargetRow As Long)
Dim LastRow As Long
Range("A" & TargetRow & ":E" & TargetRow).Copy
With Sheets("Report")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Cells(LastRow + 1, "A").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End With
End Sub

Notice I added an argument to your CopyProcedure subroutine to that calling
code can pass it the row number to be copied. I also changed how you call
the CopyProcedure subroutine from your Application.Run method to the more
normal way of calling a subroutine... simply using its name and follow that
with any arguments that it might have. Instead of activating the Report
sheet, I simply referenced it by including the commands that apply to it
with a leading dot inside of a With/EndWith block. I also removed all the
select and cell activate you used in favor of the more efficient direct
property/method calls. Perhaps this previous posting of mine (a response to
another person using Select/Selection type constructions; applies to
Activate for a cell as well) will be of some help to you in your future
programming...

Whenever you see code constructed like this...

Range("A1").Select
Selection.<whatever>

you can almost always do this instead...

Range("A1").<whatever>

In your particular case, you have this...

Range("C2:C8193").Select 'select cells to export
For Each r In Selection.Rows

which, using the above concept, can be reduced to this...

For Each r In Range("C2:C8193").Rows

Notice, all I have done is replace Selection with the range you Select(ed)
in the previous statement and eliminate the process of doing any
Select(ion)s. Stated another way, the Selection produced from
Range(...).Select is a range and, of course, Range(...) is a range... and,
in fact, they are the same range, so it doesn't matter which one you use.
The added benefit of not selecting ranges first is your active cell does not
change.
 
D

Dave Peterson

One more...

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
Cancel As Boolean)

'this probably isn't necessary, but it doesn't hurt
if target.cells.count > 1 then
exit sub
end if

if intersect(target, me.range("A:a")) is nothing then
exit sub
end if

'only cancel if you're in column A
Cancel = True ' prevent double-click from causing Edit Mode in cell
Call CopyProcedure(mycell:=target) 'why use application.run???

End Sub

Sub CopyProcedure(myCell as range)

dim DestCell as range

with worksheets("report")
set destcell = .cells(.rows.count,"A").end(xlup).offset(1,0)
end with

mycell.resize(1,5).copy
destcell.pastespecial Paste:=xlPasteValues, _
Operation:=xlNone, skipBlanks:=False, _
Transpose:=False
End Sub

=======
You may want to consider being more forgiving. Let them doubleclick on any
column in that row.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
Cancel As Boolean)

'this probably isn't necessary, but it doesn't hurt
if target.cells.count > 1 then
exit sub
end if

'only cancel if you're in column A
Cancel = True ' prevent double-click from causing Edit Mode in cell
Call CopyProcedure(mycell:=target.entirerow.cells(1))

End Sub

(the other procedure doesn't change.)

(all untested, uncompiled. Watch for typos.)
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top