Automatic creation of Hyperlinks

[Zunaid]

Hi there

Wondering if someone has a macro which scans through all cells in all
worksheets and if it finds a cell which has the same value of one of
the sheet names, it then converts that cell to a hyperlink to that
sheet.
For example, assume you have sheets names Sales, COS and GP and in the
sheet Sales, cell A3 contains the text COS. It should then make this a
hyperlink to the COS sheet.

Thanks

 

[Dick Kusleika]

Zunaid

Try this

Sub MakeHLinks()

Dim sh As Worksheet
Dim ThisSheet As Worksheet
Dim rFound As Range
Dim sFirstAdd As String

'identify the sheet on which the links will go
Set ThisSheet = ThisWorkbook.Sheets("Other")

'loop through the worksheets
For Each sh In ThisWorkbook.Worksheets
'skip the sheet identified
If sh.Name <> ThisSheet.Name Then
'find the first cell with a sheetname
Set rFound = ThisSheet.UsedRange.Find(sh.Name, , xlValues,
xlWhole)

'If a cell was found
If Not rFound Is Nothing Then
'store the address of the first cell found
sFirstAdd = rFound.Address

Do 'until the found cell is the first cell found
'add the hyperlink
rFound.Hyperlinks.Add rFound, "", sh.Name & "!A1"
'find the next cell with the sheetname
Set rFound = ThisSheet.UsedRange.FindNext(rFound)
'stop looping when the FindNext gets back to the first
'cell found
Loop Until rFound.Address = sFirstAdd
End If
End If
Next sh

End Sub