PDA

View Full Version : Solved: VBA create hyperlink



ron
04-28-2009, 07:53 AM
Hi

What am I doing wrong? The purpose of the macro is to create links in a sheet named Index to all of the sheets in the workbook. The code compiles and runs but no results.

Thanks

Ron



Sub IndexLinks()

Dim WB As Workbook
Dim ws As Worksheet
Dim i As Long
Dim rCount As Long
Dim CurSheet As String
Dim strSubAdress As String
Dim strDisplayText As String

On Error Resume Next
Application.ScreenUpdating = False
Set WB = ActiveWorkbook
Set ws = Worksheets("Index")
rCount = 1
ws.Rows("1:100").Delete
For i = Sheets("Index").Index + 1 To WB.Sheets.Count
Sheets(i).Select
CurSheet = ActiveSheet.Name
SubAddress = "='" & CurSheet & "'!$A$2"
DisplayText = CurSheet

Worksheets("Index").Hyperlink.Add Anchor:=Cells(rCount, 1), _
Address:="", SubAddress:=strSubAddress, _
TextToDisplay:=strDisplayText

rCount = rCount + 1
Next i
Sheets("Index").Select
Application.ScreenUpdating = True
End Sub

Kenneth Hobs
04-28-2009, 08:20 AM
Please use VBA code tags rather than CODE tags. Your code is all on one line when we copy/paste.

For one thing, you should not be using Select.

While not what you wanted, this might help. Try this on a blank workbook. Right click the Excel icon left of the File menu, View Code, and paste:
'http://www.ozgrid.com/VBA/sheet-index.htm
Private Sub Worksheet_Activate()
Dim wSheet As Worksheet
Dim l As Long
l = 1

With ActiveSheet
.Columns(1).ClearContents
.Cells(1, 1) = "INDEX"
.Cells(1, 1).Name = "Index"
End With

For Each wSheet In Worksheets
If wSheet.Name <> ActiveSheet.Name Then
l = l + 1
With wSheet
.Range("A1").Name = "Start_" & wSheet.Index
.Hyperlinks.Add Anchor:=.Range("A1"), Address:="", _
SubAddress:="Index", TextToDisplay:="Back to Index"
End With

ActiveSheet.Hyperlinks.Add Anchor:=ActiveSheet.Cells(l, 1), Address:="", _
SubAddress:="Start_" & wSheet.Index, TextToDisplay:=wSheet.Name
End If
Next wSheet
End Sub

You can play this right away to test.

MaximS
04-28-2009, 08:23 AM
try:


Sub IndexLinks()

Dim WB As Workbook
Dim ws As Worksheet
Dim i As Long
Dim rCount As Long
Dim CurSheet As String
Dim strSubAdress As String
Dim strDisplayText As String

On Error Resume Next
Application.ScreenUpdating = False
Set WB = ActiveWorkbook
Set ws = Worksheets("Index")
rCount = 1
ws.Rows("1:100").Delete
For i = Sheets("Index").Index + 1 To WB.Sheets.Count
Sheets(i).Select
CurSheet = ActiveSheet.Name
strSubAddress = "='" & CurSheet & "'!$A$2"
strDisplayText = CurSheet

Worksheets("Index").Hyperlinks.Add Anchor:=ws.Cells(rCount, 1), _
Address:="", SubAddress:=strSubAddress, _
TextToDisplay:=strDisplayText

rCount = rCount + 1
Next i
Sheets("Index").Select
Application.ScreenUpdating = True
End Sub

ron
04-28-2009, 08:52 AM
Kenneth, MaximS

Thanks, both procedures worked fine.

Kenneth, Sorry about using the wrong tags thanks for educating me. What would be a better choice in place of select?

Ron