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

Answer 1

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!