CODEWITHSUNDEEP
excelvbahyperlink
Mark_
Mark_

Reputation: 21

Copy text of cell after hyperlink click

I do have a list of names in sheet "Database" and through a macro I create an hyperlink for each cell of the list, pointing to the same cell A1 of Sheet "Foglio2". here follows the code:

    Sub InserisciHyperlink()
Dim ws As Worksheet: Set ws = Sheets("Database")
Dim LastRow As Long
Dim rng As Range, cell As Range

LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
Set rng = ws.Range(ws.Range("A2"), ws.Range("A" & LastRow))
For Each cell In rng
    ws.Hyperlinks.Add Anchor:=cell, Address:="", SubAddress:="Foglio2!A1", TextToDisplay:=cell.Value
Next

End Sub

The problem arises when I try to have the text of clicked hyperlink copied into cell A1 of Sheet "Foglio2".

I put following code inside Sheet "Foglio2":

    Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
Dim ws As Worksheet: Set ws = Sheets("Database")
Dim LastRow As Long
Dim rng As Range, cell As Range

LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
Set rng = ws.Range(ws.Range("A2"), ws.Range("A" & LastRow))

If Not Intersect(Target, rng) Is Nothing Then
    Sheets("Foglio2").Range("A1").Value = TargetCell.Value
    Sheets("Foglio2").Select
End If

End Sub

but after clicking on any of the hyperlinks I created, I receive the error message Runtime error 13, with the debugger underlining the following string

If Not Intersect(Target, rng) Is Nothing Then

Upvotes: 1

Views: 291

Answers (1)

VBasic2008
VBasic2008

Reputation: 54807

Try to place the following code into the Database sheet module.

Option Explicit

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
    Me.Parent.Worksheets("Foglio2").Range("A1").Value = Target.TextToDisplay
End Sub

Alternatively you could use:

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
    ThisWorkbook.Worksheets("Foglio2").Range("A1").Value = Target.Range.Value
End Sub

or even:

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
    Evaluate(Target.SubAddress).Value = Target.TextToDisplay
End Sub

Upvotes: 0

Related Questions