Using VBA to add hyperlinks to a range

mhorstman

New Member
Joined
Feb 26, 2018
Messages
10
Hi,

I'm trying to add hyperlinks to a range of cells that will link them to a specific cell on the correct worksheet. For example, I create my range and populate it with a list of names. Now I want to add hyperlinks to those names (on sheet 1) that will link to cell B2 on sheet 2. The sheet name is going to be selected by the user from a drop down on sheet 1 and there will be multiple sheets in the workbook. I need the display text to show what would be in the cell if there was no hyperlink. I'm using excel 2016.

Any help would be greatly appreciated. I keep getting an error trying to add the hyperlinks, everything else works as it should.

Private Sub Worksheet_Change(ByVal Target As Range)


'only update sheet based on changes to the Measure Selection cell
Dim KeyCells As Range
Set KeyCells = Range("I2")
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then

Dim Sh2 As Worksheet
Dim Measure As String
Dim Names As Variant
Dim List As Range
Dim LastC As String
Dim i As String
Dim j As Integer
Set Sh2 = ThisWorkbook.Worksheets("Sheet2")
'Identify selected measure
Measure = Cells(2, 9).Value
'Find the matching text for Measure on the reference sheet
Dim listaddress As String
Set List = Sh2.Range("A1:Z500").Find(Measure, lookat:=xlPart)
listaddress = List.Address
'Find the column number where Measure was found"
Dim listc As Integer
listc = List.Column
'Determine how many rows have data in them for that specific measure
Dim r As Range
Dim lastr As Integer
lastr = Sh2.Cells(Sh2.Rows.Count, listc).End(xlUp).Row
'Select the correct number of shells on the summary sheet and copy the names to it
Set r = Sh2.Range(Sh2.Cells(2, listc), Sh2.Cells(lastr, listc))
Names = r.Value
Range(Cells(2, 1), Cells(lastr, 1)).Value = Names
'add hyperlinks
Application.Hyperlinks.Add Anchor:=Range(Cells(2, 1), Cells(lastr, 1)), Address:=ThisWorkbook.Worksheets(Measure).Cells(2, 2), TextToDisplay:=Names
End If
End Sub
 

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).
So I was able to solve the first problem and it has presented a new problem :) I need to link to Cell B2 on the sheet that the variable Measure is equal to. Measure pulls from the value of a specific cell on the active sheet when the user makes their selection. I can get it to link but it will only link to cell B2 on the active sheet and not on the sheet that has the same name as the value in Measure. I've included the updated code below. Any ideas?
Dim KeyCells As Range
Set KeyCells = Range("I2")
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then

Dim Sh2 As Worksheet
Dim Measure As String
Dim Names As Variant
Dim List As Range
Dim LastC As String
Dim i As String
Dim j As Integer
Set Sh2 = ThisWorkbook.Worksheets("Sheet2")
'Identify selected measure
Measure = Cells(2, 9).Value
'Find the matching text for Measure on the reference sheet
Dim listaddress As String
Set List = Sh2.Range("A1:Z500").Find(Measure, lookat:=xlPart)
listaddress = List.Address
'Find the column number where Measure was found"
Dim listc As Integer
listc = List.Column
'Determine how many rows have data in them for that specific measure
Dim r As Range
Dim lastr As Integer
lastr = Sh2.Cells(Sh2.Rows.Count, listc).End(xlUp).Row
'Select the correct number of shells on the summary sheet and copy the names to it
Set r = Sh2.Range(Sh2.Cells(2, listc), Sh2.Cells(lastr, listc))
Names = r.Offset(columnoffset:=1).Value
Range(Cells(2, 1), Cells(lastr, 1)).Value = Names
'add hyperlinks
Dim SubA As String
MsgBox "Measure =" & Measure
SubA = ThisWorkbook.Worksheets(Measure).Cells(2, 2).Address
MsgBox "SubA =" & SubA
Worksheets("Summary Data").Hyperlinks.Add Anchor:=Range(Cells(2, 1), Cells(lastr, 1)), Address:="", SubAddress:=SubA

End If
End Sub
 
Upvote 0
Never mind, I'm an idiot :) I figured it out. I've been staring at my screen too long today apparently. Here is the updated code if anyone else happens across this post and needs it.

Dim SubA As String
MsgBox "Measure =" & Measure
SubA = ThisWorkbook.Worksheets(Measure).Cells(2, 2).Address
MsgBox "SubA =" & SubA
Worksheets("Summary Data").Hyperlinks.Add Anchor:=Range(Cells(2, 1), Cells(lastr, 1)), Address:="", SubAddress:=Measure & "!" & SubA
 
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,183
Members
453,020
Latest member
Mohamed Magdi Tawfiq Emam

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top