doubleclick Copy/paste cell VBA: Going one further

[Zetroza]

Hi,
I have had moderate sucess with my first few attempts at implementing vba code but I am still struggeling a bit here and I cant tell how advanced this problem may become to solve.
In the below table I am trying to create a macro(s) that will:
1. upon doubleclick in cell of column "fruit", copy and paste that cell into "a1" on "sheet2"
and,
2. upon doubleclick in cell of column "colour", copy and paste that cell into "a1" on "sheet3"

Fruit	Coloumn X , Y, Z etc	Colour
Apple		Red
Apple		Green
Lemon		Yellow
Lime		Green
Banana		Yellow

<tbody>
</tbody>

The following code solves step 1 only, but my attempts to input the 2nd command alongside it are proving extreamly difficult.
Any help would be greatly appreciated.
Many thanks,


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("a2:a6")) Is Nothing Then
Cancel = True
If Target.Row > 1 And Len(Target.Value) Then Worksheets("sheet2").Range("a1").Value = Target.Value
Worksheets("sheet2").Activate
End If
End Sub


Notes:
*The above code directs you to the worksheet also.
*Assume there are other coloumns (x,y,z) between the 2 in question.

 

[AlphaFrog]

Try something like this. Change the 2nd column Range to suit.

[color=darkblue]Private[/color] [color=darkblue]Sub[/color] Worksheet_BeforeDoubleClick([color=darkblue]ByVal[/color] Target [color=darkblue]As[/color] Range, Cancel [color=darkblue]As[/color] [color=darkblue]Boolean[/color])
    [color=darkblue]If[/color] [color=darkblue]Not[/color] Intersect(Target, Range("a2:a6")) [color=darkblue]Is[/color] [color=darkblue]Nothing[/color] [color=darkblue]Then[/color]
        Cancel = [color=darkblue]True[/color]
        [color=darkblue]If[/color] Target.Row > 1 And Len(Target.Value) [color=darkblue]Then[/color] Worksheets("sheet2").Range("a1").Value = Target.Value
        Worksheets("sheet2").Activate
    [color=darkblue]ElseIf[/color] [color=darkblue]Not[/color] Intersect(Target, Range("[COLOR=#ff0000]Z2:Z6[/COLOR]")) [color=darkblue]Is[/color] [color=darkblue]Nothing[/color] [color=darkblue]Then[/color]
        Cancel = [color=darkblue]True[/color]
        [color=darkblue]If[/color] Target.Row > 1 And Len(Target.Value) [color=darkblue]Then[/color] Worksheets("sheet3").Range("a1").Value = Target.Value
        Worksheets("sheet3").Activate
    [color=darkblue]End[/color] [color=darkblue]If[/color]
End [color=darkblue]Sub[/color]

 

[Zetroza]

Absolutely perfect,
Incredible response,
Thanks you very much

 

[AlphaFrog]

Absolutely perfect,
Incredible response,
Thanks you very much

You're welcome. Thanks for the feedback.

Also, you don't really have to test if Target.Row > 1 as it will always be true if it passed the Intersect test

 

[rajeev_iritty]

Hi sir,
i am a beginner
can any one help me to create a marco such a way that....
In a sheet
let b1 to b50 contains some data...
In same sheet
1. I selected cell a1 by clicking it
2. Now i double clicked b1 or b2 or .....b100
3. Then value in b1 or b2 or ....b100 must copy to a1 and cell a2 must selected to ready for next double click event

some please help me
thanking in advance