Creating hyperlink automatically from cell to sheet

[JanIngeO]

Hello guys,

I have created alot of sheets based on cell values. Now I want to automatically create hyperlinks in the cells that directs me to the sheet with the same name.

Does anyone in here have a script for this, or anything that can point me in the rigth direction? I am new to VBA, but it is superuseful in my daily worklife.

Best regards
Jan Inge

[gue2013]

Sub GenListOfSheets()

  Dim wsContent As Worksheet
  Dim ws As Worksheet
  Dim iOffset As Integer
  Dim rg As Range
  
  Set wsContent = ThisWorkbook.Worksheets("Content")
  wsContent.UsedRange.Delete  ' erase all data on worksheet
  
  Set rg = wsContent.Range("A1")
    
  ' loop through all sheets
  For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> wsContent.Name Then
      rg.Offset(iOffset) = ws.Name
      wsContent.Hyperlinks.Add Anchor:=rg.Offset(iOffset), Address:="", _
                         SubAddress:="'" & ws.Name & "'!A1", TextToDisplay:=ws.Name
      iOffset = iOffset + 1
   End If
  Next
End Sub

I attached a sample file. Only thing is that a worksheet with name "Content" must be available (or change name)

[JanIngeO]

This works absolutely great, thank you .

I have two more questions if it is ok for you:

1. Is there anyway to edit this so it only makes hyperlink from cell A6-A999, instead of deleting all other info in sheet?
2. Is it possible to run this all the time, so when you add a new sheet or cell is comes up automatically?

Again, thank you.

//JIO

[gue2013]

of course
1) from A6 down, so there is data above which should not be erased, but why limited to A999? Is there data below? if not then I would propose to delete everything down from A6.
- above A6 is data and no hyperlinks to sheets? --> then the destination address has to be change to "A6"

Sub GenListOfSheets()

  Dim wsContent As Worksheet
  Dim ws As Worksheet
  Dim iOffset As Integer
  Dim rg As Range
  
  Set wsContent = ThisWorkbook.Worksheets("Content")
  wsContent.Range("A6").Resize(1000).Delete ' erase all hyperlinks
  
  Set rg = wsContent.Range("A6")
    
  ' loop through all sheets
  For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> wsContent.Name Then
      rg.Offset(iOffset) = ws.Name
      wsContent.Hyperlinks.Add Anchor:=rg.Offset(iOffset), Address:="", _
                         SubAddress:="'" & ws.Name & "'!A1", TextToDisplay:=ws.Name
      iOffset = iOffset + 1
   End If
  Next
End Sub

2) there is a workbook event that can trigger the macro

Private Sub Workbook_NewSheet(ByVal Sh As Object)
  GenListOfSheets
End Sub

But if you afterwards rename a worksheet then you have to trigger it manually.

I have found something on the internet but this means you have to add the class to the workbook and additionally the function Worksheet_Activate() on every sheet
https://stackoverflow.com/questions/...event-in-excel