How do I add a Hyperlink to each item in a column? - excel

Question

Column B is Employee name and is also an individual Worksheet name.
Anticipated Outcome: A hyperlink to the individual Worksheet on each item in column B.
Issue: The code starts and stops at the top of the list and puts in a hyperlink to the last employee on the list.
Sub HyperlinkAdd()
ts= "Employee List"
lx = sheets(ts).Range("L1").value
Sheets(ts).Range("L1").Formula= "=Subtotal(3,B4:B1000)+3"
For x = 3 to lx
If Range("B" & x).value <> "" And Range("B" & x).value <> "Employees" Then
Sheets(ts).Hyperlinks.Add Anchor:Selection, Address:="", _
Subaddress:="'" & Range("B" & x) & "'!A1"
Else
End if
Next X
End Sub

Answer 1

Try this:
Sub add_hyperlink()
Dim target_range As Range
Dim cell As Range
Set target_range = ThisWorkbook.Sheets("Sheet1").Range("B1", Range("B1").End(xlDown))
For Each cell In target_range
ThisWorkbook.Sheets("Sheet1").Hyperlinks.Add Anchor:=cell, Address:="https://www.google.com/", SubAddress:= _
"Sheet1!A1", TextToDisplay:=cell.Value
Next cell
End Sub

Answer 2

How about the following, simply amend the range you want to work with, I've set it up so it works from B1 to the last populated cell on Column B:
Sub HyperlinkAdd()
Dim ws As Worksheet: Set ws = Sheets("Sheet1")
'declare and set your working worksheet, amend as required
Dim LastRow As Long
Dim rng As Range, cell As Range
LastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
'get the last row with data on Column b
Set rng = ws.Range(ws.Range("B1"), ws.Range("B" & LastRow))
'set the range to work with
For Each cell In rng
If cell.Value <> "" And cell.Value <> "Employees" Then
ws.Hyperlinks.Add Anchor:=cell, Address:="", SubAddress:=cell.Value & "!A1", TextToDisplay:=cell.Value
End If
Next
End Sub

Answer 3

I take a different tack and make a table of contents with each sheet (with exceptions) added to the list, and hyperlinks forward and back. You'll want to change the location of the "return" link on the employee sheet to somewhere suitable.
Private Sub Make_TOC()
'TOC Table of contents Hyperlink
Dim bkEmployees As Workbook
Set bkEmployees = ActiveWorkbook
Dim shContents As Worksheet, shDetail As Worksheet
If Not WorksheetExists("Contents") Then
Set shContents = bkEmployees.Sheets.Add(before:=ActiveWorkbook.Sheets(1))
shContents.Name = "Contents"
Else
Set shContents = bkEmployees.Sheets("Contents")
shContents.Move before:=bkEmployees.Sheets(1)
End If
shContents.Activate
shContents.Range("A1").Select
shContents.Columns("A:B").NumberFormat = "#"
For locX = 2 To bkEmployees.Sheets.Count
Select Case bkEmployees.Sheets(locX).Name
'add any sheets you don't want messed with
Case "Sheet1", "Sheet2", "Contents"
'don't include the sheets above in the TOC
Case Else
shContents.Cells(locX, 1) = bkEmployees.Sheets(locX).Name
shContents.Cells(locX, 1).Select
strSubAddress = "'" & shContents.Cells(locX, 1).Value & "'!A1"
shContents.Hyperlinks.Add Anchor:=shContents.Cells(locX, 1), _
Address:="", SubAddress:="'" & bkEmployees.Sheets(locX).Name & "'" & "!A1", _
TextToDisplay:=bkEmployees.Sheets(locX).Name, ScreenTip:="Go to Detail Sheet"
'change this code to put the anchor for the return link somewhere suitable.
bkEmployees.Sheets(locX).Hyperlinks.Add Anchor:=bkEmployees.Sheets(locX).Cells(1, 1), _
Address:="", SubAddress:="'" & shContents.Name & "'" & "!A" & locX, _
TextToDisplay:="Return to TOC", ScreenTip:="Return to Table of Contents"
End Select
Next locX
shContents.Range("A1").Value = "Table Of Contents"
shContents.Range("A1").Select
shContents.Columns("A").AutoFit
End Sub