Macro to dynamically hyperlink to different cell in another worksheet

[meowws]

Hi All,
Looking to create a macro which will automatically reference a specific cell (different worksheet), instead of manually changing the cell reference and linking one by one.
For example, user will click on "TB" (1st image), this will take them to the Fines cell in TB worksheet (2nd image).

Have attempted to write a simple macro, however is not working and looking for some advice.
Also looking to see how to go about specifying fines to be linked to fines with an AND function?

Sub Hyperlink()

For Each reference In Range("B3:B7")
If reference = "TB" Then
Worksheets("TB").Activate
Cells(2, "A").Activate.Hyperlinks.Add Anchor:=ActiveCell, Address:="", SubAddress:="'Queries' !B3", TextToDisplay:="TB"

Exit For
End If
Next

End Sub

 

[meowws]

Made some changes - however saying invalid call or argument
I can see RDRef is empty and no value is assigned to it, not sure why.

Sub Hyperlink()

Dim reference As Range
Dim TBRef As Variant
Dim RDDef As Variant

x = 2
y = 2

Worksheets("Queries").Select

For Each reference In Range("B3:B7").Cells
If reference = "TB" Then
TBRef = Worksheets("TB").Cells(x, "A").Value
ActiveCell.Hyperlinks.Add Anchor:=reference, Address:="", SubAddress:=TBRef, TextToDisplay:="TB"
Debug.Print TBRef
Else
RDRef = Worksheets("R&D Schedule").Cells(y, "A").Value
ActiveCell.Hyperlinks.Add Anchor:=reference, Address:="", SubAddress:=RDRef, TextToDisplay:="R&D"
Debug.Print RDRef
End If
x = x + 1
y = y + 1
Next reference
End Sub

 

[Alex Blakenburg]

Would this be an option for you ?

• In Queries have the Hyperlinks just point to A1 in TB or R&D Schedule as required.
• Right Click on the Queries Sheet Tab Name and select View Code
• In the code screen that appears copy in the code below

Clicking on a Hyperlink in Queries will trigger the code.
The Hyperlink address will tell the code which sheet you want and the code will then search for the description from Column A in the target sheet.

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
    Dim strSubAddShtName As Variant
    Dim destSht As Worksheet
    Dim cellFindDesc As Range
    
    strSubAddShtName = Replace(Split(Target.SubAddress, "!")(0), "'", "")
    Set destSht = Worksheets(strSubAddShtName)
    
    Set cellFindDesc = destSht.Columns(1).Find(what:=Target.Parent.Offset(, -1), _
                                LookIn:=xlFormulas, SearchDirection:=xlNext, MatchCase:=False)
    If cellFindDesc Is Nothing Then
        Exit Sub
    Else
        cellFindDesc.Select
    End If
                           
End Sub

 

[meowws]

Thank you for that!

Sub addHyperlink()

Dim mysht As Worksheet
Dim sht As Worksheet

Set mysht = ActiveSheet
Set sht = ThisWorkbook.Worksheets("TB")
Set sht2 = Thisworkbook.Worksheets("R&D")

Dim reference As Range
Dim TBRef As String
Dim RDDef As String

For Each reference In mysht.Range("B3:B7").Cells
If reference = "TB" Then
        TBRef = getAddressOfCell(reference.Offset(, -1), sht.Range("A1:B5").CurrentRegion)
        mysht.Hyperlinks.Add Anchor:=reference, Address:="", subAddress:=TBRef, TextToDisplay:="TB"
        Else
        RDRef = getAddressOfCell(reference.Offset(, -1), ThisWorkbook.Worksheets("R&D Schedule").Cells(1, 1).CurrentRegion)
        mysht.Hyperlinks.Add Anchor:=reference, Address:="", subAddress:=RDRef, TextToDisplay:="R&D"
    End If
End If

Private Function getAddressOfCell(strFind As String, rgSearchIn As Range) As String
Dim rgFound As Range
With rgSearchIn
    Set rgFound = .Find(what:=strFind)
    If Not rgFound Is Nothing Then
        getAddressOfCell = rgFound.Address(True, True, , True)
    End If
End With
End Function