VBA to create hyperlinks from a list

Question

I have the below VBA:

Sub List_creator()
'
' List_creator Macro
' Creates list of Names which will then become tab names
'

'
Sheets("ALL Scheme Derivatives").Select
ActiveSheet.Range("$A$1:$Q$64944").AutoFilter Field:=9, Criteria1:=Array( _
    "A - Mini", "B - Supermini", "C - Lower Medium", "D - Upper Medium", _
    "E - Executive", "G - Specialist Sports", "H - MPV", "I - 4 x 4", "Y - LCV", "="), _
    Operator:=xlFilterValues
Columns("B:B").Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets("List").Select
Sheets("List").Name = "List"
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Application.CutCopyMode = False
ActiveSheet.Range("$A$1:$A$1047980").RemoveDuplicates Columns:=1, Header:= _
    xlNo

Dim ws As Worksheet
Dim Ki As Range
Dim ListSh As Range

With Worksheets("List")
    Set ListSh = .Range("A2:A" & .Cells(.Rows.Count, "A").End(xlUp).Row)
End With

On Error Resume Next
For Each Ki In ListSh
    If Len(Trim(Ki.Value)) > 0 Then
        If Len(Worksheets(Ki.Value).Name) = 0 Then
            Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = Ki.Value
         ActiveSheet.[a1] = ActiveSheet.Name
         'Copy from sheet Helper
        Sheets("Helper").Range("A2:K92").Copy Destination:=ActiveSheet.Range("A2")
        ' Sets column widths
        Columns("B:C").ColumnWidth = 10.71
        Columns("D").ColumnWidth = 70.71
        Columns("E:J").ColumnWidth = 10.71
        ' Deletes all rows which aren't needed
        Dim LR As Long, Found As Range
        LR = Range("C" & Rows.Count).End(xlUp).Row
        Set Found = Columns("C").Find(what:="-", LookIn:=xlValues, lookat:=xlWhole)
        If Not Found Is Nothing Then Rows(Found.Row & ":" & LR).Delete
        End If
    End If
Next Ki

' Return to Manual

Sheets("MANUAL").Select
End Sub

This creates a list of names (removing any duplicates) and then for each name in the list, a new worksheet is added to the workbook. These new worksheets have the exact name as it would appear in the aforementioned created list. Is there a way in which I could then create a hyperlink to each of these created worksheets on a separate worksheet named "Contents" (starting in cell L8, having one hyperlink per row).

Thanks!

EDIT:

Sub List_creator()
'
' List_creator Macro
' Creates list of Names which will then become tab names
'

'
Sheets("ALL Scheme Derivatives").Select
ActiveSheet.Range("$A$1:$Q$64944").AutoFilter Field:=9, Criteria1:=Array( _
    "A - Mini", "B - Supermini", "C - Lower Medium", "D - Upper Medium", _
    "E - Executive", "G - Specialist Sports", "H - MPV", "I - 4 x 4", "Y - LCV", "="), _
    Operator:=xlFilterValues
Columns("B:B").Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets("List").Select
Sheets("List").Name = "List"
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Application.CutCopyMode = False
ActiveSheet.Range("$A$1:$A$1047980").RemoveDuplicates Columns:=1, Header:= _
    xlNo


Dim ws As Worksheet
Dim Ki As Range
Dim ListSh As Range
Dim iLinkRow As Integer


With Worksheets("List")
    Set ListSh = .Range("A2:A" & .Cells(.Rows.Count, "A").End(xlUp).Row)
End With

On Error Resume Next
For Each Ki In ListSh
    If Len(Trim(Ki.Value)) > 0 Then
        If Len(Worksheets(Ki.Value).Name) = 0 Then
         Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = Ki.Value
         ActiveSheet.[a1] = ActiveSheet.Name
         iLinkRow = 11
         Sheets("Contents").Hyperlinks.Add Anchor:=Sheets("Contents").Cells(iLinkRow, 8), Address:=ActiveSheet.Name, SubAddress:=ActiveSheet.Name, TextToDisplay:=ActiveSheet.Name
         iLinkRow = iLinkRow + 1
        'Copy from sheet Helper
        Sheets("Helper").Range("A2:K92").Copy Destination:=ActiveSheet.Range("A2")
        ' Sets column widths
        Columns("B:C").ColumnWidth = 10.71
        Columns("D").ColumnWidth = 70.71
        Columns("E:J").ColumnWidth = 10.71
        ' Deletes all rows which aren't needed
        Dim LR As Long, Found As Range
        LR = Range("C" & Rows.Count).End(xlUp).Row
        Set Found = Columns("C").Find(what:="-", LookIn:=xlValues, lookat:=xlWhole)
        If Not Found Is Nothing Then Rows(Found.Row & ":" & LR).Delete
        End If
    End If
Next Ki

' Return to Manual

Sheets("MANUAL").Select
End Sub

I suggest looking at the worksheet_changed event and adding instructions to tell VBA to activate X sheet once its name is selected from your contents sheet. — Amen Jlili
@Jelly I think the OP is actually asking about adding hyperlinks to his contents sheet that will allow him to navigate to all the named sheets. — 3-14159265358979323846264

3-14159265358979323846264 3-14159265358979323846264 · Accepted Answer · 2015-07-22T13:39:05

You can add hyperlinks in your workbook that refer to other sheets as follows ...

ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
    "Sheet2!A1", TextToDisplay:="Sheet2!A1"

So for instance, if you had a sheet called John you would use the following to add a link into cell L8 on the Contents sheet...

Sheets("Contents").Hyperlinks.Add Anchor:=Sheets("Contents").Range("L8"), Address:="", SubAddress:= _
    "John!A1", TextToDisplay:="John"

You should be able to put a line of code similar to this (obviously without hard coding the SubAddress and TextToDisplay parameters) in the loop that creates the worksheets.

You also need to update the Anchor parameter. Let's assume the following loop

Dim iLinkRow as Integer
iLinkRow = 11
For Each Ki in ListSh
    'your code that creates the sheet
    Sheets("Contents").Hyperlinks.Add Anchor:=Sheets("Contents").Cells(iLinkRow, 8), Address:="", SubAddress:= _ ActiveSheet.Name, TextToDisplay:=ActiveSheet.Name
    iLinkRow = iLinkRow + 1
Next Ki

Here, I am using Cells(y,x) (rather than Range) which accepts two integers row,column. The column number will always be 8 (L is the 8th column) and the row (iLinkRow) will be increased by 1 for each sheet.

Update the code as follows ...

On Error Resume Next
iLinkRow = 11
For Each Ki In ListSh
If Len(Trim(Ki.Value)) > 0 Then
    If Len(Worksheets(Ki.Value).Name) = 0 Then
     Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = Ki.Value
     ActiveSheet.[a1] = ActiveSheet.Name
     Sheets("Contents").Hyperlinks.Add Anchor:=Sheets("Contents").Cells(iLinkRow, 8), Address:=ActiveSheet.Name, SubAddress:=ActiveSheet.Name, TextToDisplay:=ActiveSheet.Name
     iLinkRow = iLinkRow + 1

You need to set iLinkRow = 11 before the loop starts!

VBA to create hyperlinks from a list

1 Answers