G
Guest
Question - I have a pull down menu in Cell T. I want excel to copy Cell T to
Cell U when I double click on Cell T after selecting something from the pull
down menu (similar to what it does below). Can you add another procedure to
the sheet code already created for this workbook or is this not possible?
See below for current sheet code used.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
Cancel As Boolean)
If Not
Application.Intersect(Range("n8:n207,q8:q207,y8:y207,ab8:ab207,ae8:ae207,ah8:ah207,ak8:ak207,an8:an207,aq8:aq207,at8:at207,aw8:aw207,az8:az207,bc8:bc207"),
Target) Is Nothing Then
'For a range use
'If Not Application.Intersect(Range("A1:A20"), Target) Is Nothing Then
On Error GoTo endit
Application.EnableEvents = False
Application.ScreenUpdating = False
With Target
.Value = "R"
.Offset(0, 1).Copy
.Offset(0, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks _
:=False, Transpose:=False
End With
Application.CutCopyMode = False
End If
Cancel = True
Range("as7").Select
endit:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Thanks for any help you can provide
Robert B.
Cell U when I double click on Cell T after selecting something from the pull
down menu (similar to what it does below). Can you add another procedure to
the sheet code already created for this workbook or is this not possible?
See below for current sheet code used.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
Cancel As Boolean)
If Not
Application.Intersect(Range("n8:n207,q8:q207,y8:y207,ab8:ab207,ae8:ae207,ah8:ah207,ak8:ak207,an8:an207,aq8:aq207,at8:at207,aw8:aw207,az8:az207,bc8:bc207"),
Target) Is Nothing Then
'For a range use
'If Not Application.Intersect(Range("A1:A20"), Target) Is Nothing Then
On Error GoTo endit
Application.EnableEvents = False
Application.ScreenUpdating = False
With Target
.Value = "R"
.Offset(0, 1).Copy
.Offset(0, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks _
:=False, Transpose:=False
End With
Application.CutCopyMode = False
End If
Cancel = True
Range("as7").Select
endit:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Thanks for any help you can provide
Robert B.