Vba to add hyplinks to cells using value of named range for sheet name

[Youngdand]

Hi, after failing dismally trying to use =hyperlink, i am looking for a solution which will loop through a number of cells, and add a hyperlink to each cell pulling the sheet name from a named range. i will trigger this as an on open event. The aim of this is to provide dynamic links from a summary sheet which pulls information based on teams where members which change frequently.

my sheet names are stored in the ranges bteam 1 - 10 j team 1 - 10 and mteam 1 - 10

I tried the below which did not work where am i going wrong?

Private Sub Workbook_Open()
Dim summary As Worksheet
Set summary = Sheets("summary")
summary.Activate
summary.Hyperlinks.Delete ' remove existing hyperlinks.

For i = 10 To 1
With summary
.Hyperlinks.Add anchor:=summary.Cells(i + 3, 2), Address:=Sheets(bteam & i.value)), TextToDisplay:="bteam" & i
.Hyperlinks.Add anchor:=summary.Cells(i + 3, 8), Address:=Sheets(Range(jteam & i.value).Value)), TextToDisplay:="jteam" & i
.Hyperlinks.Add anchor:=summary.Cells(i + 3, 14), Address:=Sheets(Range(mteam & i.Value)), TextToDisplay:="mteam" & i
End With
Next i
End Sub

Thanks,

Dan.

 

[Youngdand]

Hi,

Still Struggling with this, but a little bit closer, any help would be appreciated.

Option Explicit
'Private Sub Workbook_Open()
Sub testing()
Dim i As Long
Dim summary As Worksheet
Dim tw As Workbook
Dim bt As Variant, mt As Worksheet, jt As Worksheet
Dim NSN As Worksheet
Set tw = ThisWorkbook
Set summary = Sheets("summary")
summary.Activate
ActiveSheet.Hyperlinks.Delete
i = 10
'Set jt = Range("jteam" & i)
'Set mt = Range("mteam" & i)
Do While i > 0
Set bt = Range("bteam" & i)
    If bt.Value <> "" Then
        Set NSN = Sheets(bt.Value)
        With summary
        .Hyperlinks.Add Anchor:=.Cells(i + 3, 2), _
        Address:="", _
        SubAddress:=NSN.Name & "!a1", _
        TextToDisplay:=bt.Value
'.Hyperlinks.Add anchor:=summary.Cells(i + 3, 8), Address:=Sheets(Range(jteam & i).Value), TextToDisplay:="jteam" & i
'.Hyperlinks.Add anchor:=summary.Cells(i + 3, 14), Address:=Sheets(Range(mteam & i).Value), TextToDisplay:="mteam" & i
i = i - 1
End With
Else
End If
i = i - 1
MsgBox (i)
Loop

End Sub

 

[Youngdand]

Solution for posterity

Sub Create_Dynamic_hyperlinks()
Dim i As Long
Dim summary As Worksheet
Dim tw As Workbook
Dim bt As Variant
Dim NSN As Worksheet
Set tw = ThisWorkbook
Set summary = Sheets("summary")
summary.Activate
Range("A4:R13").ClearHyperlinks
Range("A4:R13").Font.Color = vbBlack
Application.ScreenUpdating = False
i = 17
Do While i > 0
Set bt = Range("bteam" & i)
    If bt.Value <> "" Then
        Set NSN = Sheets(bt.Value)
        With summary
        .Hyperlinks.Add Anchor:=.Cells(i + 3, 2), _
        Address:="", _
        SubAddress:=NSN.Name & "!a1", _
        TextToDisplay:=bt.Value
        i = i - 1
        End With
    Else
    i = i - 1
    End If
Loop
End Sub