Help to hyperlink cells

[jerry]

there are two tabs - tab 1 and tab 2. Tab 1 contains data rows with
column A containing a unique number. Tab 2 contains details for each
unique number. I want to create a macro so that when user clicks on
the number on tab1, he/she is redirected to the same number on tab2.
May i request you help ?

Thanks....

 

[Dave Peterson]

First, there is no _click event. You could fire the macro by doubleclicking on
that cell or by rightclicking on that cell.

This code uses the _beforerightclick event.

Rightclick on the worksheet tab that should have this behavior.

Select view code.

Paste this into the newly opened code window (usually on the right side).

Option Explicit
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, _
Cancel As Boolean)

Dim res As Variant
Dim OtherSheet As Worksheet
Dim OtherRng As Range

If Target.Cells.Count > 1 Then
Exit Sub 'only one cell at a time
End If

If Intersect(Target, Me.Range("a:A")) Is Nothing Then
Exit Sub 'only look in column A
End If

If IsEmpty(Target.Value) Then
Exit Sub 'there better be something in the cell
End If

Set OtherSheet = Worksheets("Sheet2")

Set OtherRng = OtherSheet.Range("a:a")

res = Application.Match(Target.Value, OtherRng, 0)

If IsError(res) Then
Beep 'no match found
'MsgBox "No Match found"
Else
Application.Goto OtherRng(res), scroll:=True
End If

Cancel = True 'don't show the rightclick menu

End Sub

Change the name of the othersheet to match your workbook.

Then back to excel and test it out.

 

[Tim Williams]

You could do this with hyperlinks and catch the followhyperlink event
on tab1 (right-click on the sheet tab, select "view code" and copy/
paste the code below)

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)

Dim LinkedVal
Dim LinkedCell As Range

Set LinkedCell = Me.Range(Target.Range.Address)
LinkedVal = LinkedCell.Value
Dim f As Range
'adjust next line to suit...
Set f = Sheet2.Columns(1).Find(LinkedVal, , xlValues, xlWhole)
If Not f Is Nothing Then
f.Parent.Activate
f.Select
Else
MsgBox "No match on Sheet2 for '" & LinkedVal & "'"
LinkedCell.Select
End If
End Sub


To create the hytperlinks on the values in the first sheet: place this
code in a regular module, select your cells and then Alt+F8 to run the
procedure

Sub AddLinksToSelectedCells()
Dim c As Range, sht As Worksheet
Set sht = Selection.Parent
Selection.Hyperlinks.Delete
For Each c In Selection.Cells
If c.Value <> "" Then
sht.Hyperlinks.Add Anchor:=c, Address:="", _
SubAddress:="Sheet1!A1", _
TextToDisplay:=CStr(c.Value)
End If
Next c
End Sub



Tim