Dynamic hyperlink in VBA

[Bondoo7]

I have a workbook.

In sheet3 there are column A employee id's e.g. EID123,EID1234 (i.e.EID*** or EID***X format) and Column B their address Column C their mobile nos etc.
Now in other sheets of same workbook I have EID mentioned individually in a cell or between the texts like "EID123" or "Mr.Obama wants to promote EID3456 to be next president".

I was wondering if I can convert the references of EID***X and EID*** across the workbook to hyperlinks apart from those in sheet 3, so that when I click on EID***X anywhere in the workbook the particular EID***X selected from sheet3.

Thanks

[p45cal]

Quite convoluted to write code to create and make dynamic hyperlinks in cells and impossible to have more than 1 hyperlink in a cell (note the use if impossible to encourage others to prove me wrong - although it is possible to put invisible shapes over the words and have those hyperlink to different places).
However, some quite simple code is in the attached to respond to right click on a (single) cell in any sheet except Sheet3. Still only works on the first EID no. in a cell.
It's a starting point maybe.

If anyone's interested this is the code in the ThisWorkbook code-module:
Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
If Not Sh.Name = "Sheet3" And Target.Count = 1 Then
If InStr(UCase(Target.Value), "EID") > 0 Then
Cancel = True
x = Split(Target.Value, " ")
For Each eid In x
If UCase(Left(eid, 3)) = "EID" Then Exit For
Next eid
Set Destn = Sheets("Sheet3").Columns(1).Find(What:=eid, LookIn:=xlFormulas, lookat:=xlWhole, searchformat:=False)
If Not Destn Is Nothing Then
Application.Goto Destn
Else
MsgBox "Can't find " & eid
End If
End If
End If
End Sub

[Bondoo7]

Quite convoluted to write code to create and make dynamic hyperlinks in cells and impossible to have more than 1 hyperlink in a cell (note the use if impossible to encourage others to prove me wrong - although it is possible to put invisible shapes over the words and have those hyperlink to different places).
However, some quite simple code is in the attached to respond to right click on a (single) cell in any sheet except Sheet3. Still only works on the first EID no. in a cell.
It's a starting point maybe.

If anyone's interested this is the code in the ThisWorkbook code-module:
Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
If Not Sh.Name = "Sheet3" And Target.Count = 1 Then
If InStr(UCase(Target.Value), "EID") > 0 Then
Cancel = True
x = Split(Target.Value, " ")
For Each eid In x
If UCase(Left(eid, 3)) = "EID" Then Exit For
Next eid
Set Destn = Sheets("Sheet3").Columns(1).Find(What:=eid, LookIn:=xlFormulas, lookat:=xlWhole, searchformat:=False)
If Not Destn Is Nothing Then
Application.Goto Destn
Else
MsgBox "Can't find " & eid
End If
End If
End If
End Sub

Hi,
Thanks a ton it works, I want to be a VBA expert I'm working on it. I want to be in position to answer these queries.

[Bondoo7]

Hi,
Hi Any other option to cater the scenario if there are two AOCT id's

[p45cal]

You haven't supplied a file so I have no idea what an AOCT id is.
Sticking with EIDs, see attached, especially cell D30 on sheet1.

Oh, and have a read of http://www.excelguru.ca/content.php?184



For anyone interested, the amended code is:
Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
If Not Sh.Name = "Sheet3" And Target.Count = 1 Then
If InStr(UCase(Target.Value), "EID") > 0 Then
Cancel = True
x = Filter(Split(Target.Value, " "), "EID", True, vbTextCompare)
For i = LBound(x) To UBound(x)
eid = x(i)
Set Destn = Sheets("Sheet3").Columns(1).Find(What:=eid, LookIn:=xlFormulas, lookat:=xlWhole, searchformat:=False)
If Not Destn Is Nothing Then
Application.Goto Destn
If i < UBound(x) Then
If MsgBox("This one?" & IIf(i = UBound(x) - 1, vbLf & "(There's only one more)", ""), vbYesNo, "Move on… or not?") = vbYes Then Exit For
End If
Else
MsgBox "Can't find " & eid
End If
Next i
End If
End If
End Sub