Copy A Cell On Double Click And Paste to A Different Cell on Another Sheet Automatically

user_13724601 0
Viewed 701

I really need your help.

Basically I have 2 sheets that I really am concerned for my project as pictured below.

  1. MUFG Client
  2. MUFG Matched

enter image description here enter image description here

I am looking for VBA code that allows me to:

  • Double click on a cell within a range (B3:B300) on MUFG Client Sheet.
  • On Double clicking, it will take the content of the cell I have double clicked on (could be any cell in the above range) and paste the text/value into a different cell on MUFG Matched sheet (Cell D4) automatically.

Any help would be greatly appreciated. I have tried a couple of things such as making hyperlink to the content within the range but it still doesn't work at all and fails too many times.

Thanks

Rendi

worksheet double-click hyperlink excel
2 Answers

The following VBA code should work as you described:

Option Explicit
Function InRange(Range1 As Range, Range2 As Range) As Boolean
' returns True if Range1 is within Range2
Dim InterSectRange As Range
    Set InterSectRange = Application.Intersect(Range1, Range2)
    InRange = Not InterSectRange Is Nothing
    Set InterSectRange = Nothing
End Function

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If InRange(ActiveCell, Worksheets("MUFG Client").Range("B3:B300")) Then
        Selection.Copy Worksheets("MUFG Matched").Range("d4")
    End If
End Sub

Make sure that you place this code into the worksheet code area of MUFG Client, since that is where you will be double clicking.

user_119658280

You need a Worksheet_BeforedoubleClick event - look them up if you haven't met worksheet events before.
Then it would be something like;

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

'Check if it's in the range:
If Target.Column = 2 And Target.Row <300 And Target.Row >3 Then
    'Copy to relevant location
    Target.Copy Worksheets("MUFG Matched").Range("D4")
End If

End Sub
user_122319840
Related