Copy Names and add hyperlink (Excel VBA)

If you would provide a sample workbook, it would help expedite your solution.

Dvae

It would likely be simpler to create the list based upon the sheets present.
Or would you like missing sheets to be created in not present in the workbook?

The attached workbook has two main code parts:

1) Added to the sheet with the "links"
Will set column A to open the sheet with matching Sheet.Name

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("A:A")) Is Nothing Then Sheets(Target.Value).Select
End Sub

Select allOpen in new window

2) Added to a code module to extract sheet names to sheet1

Sub sheetsMake()
Dim wb As Workbook
Dim ws As Worksheet

Set wb = ThisWorkbook
Set ws = wb.Sheets("Sheet1")
x = 2
For Each sht In wb.Sheets
    ws.Cells(x, 1) = sht.Name
    x = x + 1
Next
End Sub

Select allOpen in new window

See attached workbook example..
Code can be changed to your specifics, though this should get you started.
Sheet-selection.xlsm

The following code adds hyperlinks for each sheet:

Sub sheetsMake()
Dim wb As Workbook
Dim ws As Worksheet

Set wb = ThisWorkbook
Set ws = wb.Sheets("Summary")
x = 13
For Each sht In wb.Sheets
    ws.Hyperlinks.Add Anchor:=ws.Cells(x, 2), Address:="", SubAddress:=sht.Name & "!A1", TextToDisplay:=sht.Name
    x = x + 1
Next
End Sub

Select allOpen in new window

Sheet-selection.xlsm

Hello,

Attached is a workbook example of what I was trying to achieve.

On the Summary worksheet you have the list of names which is just a list of unique names from column F on the data worksheet.

I would like the code to check column F each time it runs and should update the list on the summary workbook each time it runs. I would like to names to be hyperlinks to their relevant tabs.

Dont worry about the tabs the persons tab will always be there.


hope this helps - if you add the code into the example workbook and post back that would help me greatly.
example-workbook.xlsx

And finally, this one has a userform which fills with all the sheetnames to allow users to pick from a list.
Sheet-selection.xlsm

The attached workbook is based upon Sheets (as you say all names will have a sheet)
example-workbook.xlsm

Here is the code and attached workbook for the data name method:

Sub DataNamesMake()
Dim wb As Workbook
Dim ws As Worksheet

Set wb = ThisWorkbook
Set ws = wb.Sheets("Summary")
Set ws2 = wb.Sheets("data")
x = 13
y = 1

Do While Len(ws2.Cells(y, 6)) <> 0
If WorksheetFunction.CountIf(ws.Range("B:B"), ws2.Cells(y, 6).Value) = 0 Then
    ws.Hyperlinks.Add Anchor:=ws.Cells(x, 2), Address:="", SubAddress:=ws2.Cells(y, 6).Value & "!A1", TextToDisplay:=ws2.Cells(y, 6).Value
    x = x + 1
End If
y = y + 1
Loop
End Sub

Select allOpen in new window

example-workbook.xlsm

The attached workbook will only add NEW names from the data list (leaving existing ones where they are)

Sub DataNamesMake()
Dim wb As Workbook
Dim ws As Worksheet

Set wb = ThisWorkbook
Set ws = wb.Sheets("Summary")
Set ws2 = wb.Sheets("data")
x = ws.Cells(Rows.Count, 2).End(xlUp).Row + 1
y = 1

Do While Len(ws2.Cells(y, 6)) <> 0
If WorksheetFunction.CountIf(ws.Range("B:B"), ws2.Cells(y, 6).Value) = 0 Then
    ws.Hyperlinks.Add Anchor:=ws.Cells(x, 2), Address:="", SubAddress:=ws2.Cells(y, 6).Value & "!A1", TextToDisplay:=ws2.Cells(y, 6).Value
    x = x + 1
End If
y = y + 1
Loop
End Sub

Select allOpen in new window

example-workbook.xlsm

That's quite a few posts.

Yep, hopefully one of them is good :)

I am just worried that:
Either
There are sheets which are not in the list.
or
There are names in the list without sheets.

Whether the list of hyperlinks should be fresh each time or should add on each time.
Only gisvpn can know for sure, so have tried to give a good few variations.

Hi The_Barman

Thanks for the posts there are some good suggestions there. I had a question.

I am using the code below with a few minor changes - however all works perfects but the hyperlink gives an error message when you click on the hyperlink (as attached).

I have double checked the sheet does exist for the name however it gives this error - any ideas.






im wb1 As Workbook
Dim ws1 As Worksheet

Set wb1 = ThisWorkbook
Set ws1 = wb1.Sheets("Summary")
Set ws2 = wb1.Sheets("data")

ws1.Rows("15:1000").Delete
x = 15
y = 1

Do While Len(ws2.Cells(y, 6)) <> 0
If WorksheetFunction.CountIf(ws1.Range("B:B"), ws2.Cells(y, 6).Value) = 0 Then
    ws1.Hyperlinks.Add Anchor:=ws1.Cells(x, 2), Address:="", SubAddress:=ws2.Cells(y, 6).Value & "!A1", TextToDisplay:=ws2.Cells(y, 6).Value
    ws1.Cells(x, 4) = WorksheetFunction.SumIf(ws2.Range("F:F"), ws1.Cells(x, 2), ws2.Range("J:J"))
    x = x + 1
End If
y = y + 1
Loop



On another note to your questions - a fresh list is great to have each time and the ws1.Rows("15:1000").Delete is perfect for this.

As this code does not create the tabs which would at this point already exist - can you add to the code a flag that if a link and name is created but there isnt a sheet it creates the link but makes the text red and if there is a sheet that exists but a name is not on the list it puts the sheet name at the end of the list and makes the text blue?
Capture.PNG

I cannot say why the hyperlink is not working, it may be case sensitive, could you post example workbook for testing.

As for creating new sheets if the name is missing, I will work on that for you asap.

Hi The Barman,

Thanks that sounds great - could I ask what the error message I get does suggest - it currently has a reference attached to the hyperlink that does not exist?