Add Hyperlinks Dynamically

dsmith616 · Apr 28th 2016

I've been successful using the code below adding hyperlinks when I know where the information will be (i.e. a specific column). However, I'm looking to alter this to search by header names to the column to create the link. Reason being is many reports are created and depending on who or what columns of information is needed it may differ each time. Thanks for any feedback.

Code

Option Explicit










Sub HyperLink()








Dim dm As Range
Dim title As Range




Dim url As String
url = "www.microsoft.com"








'This will go to cell I2, and get the last row
Dim lastRow As Long




lastRow = GetLastRow("I2")
'MsgBox ("The last row is I" & lastRow)




Dim i As Integer
For i = 2 To lastRow
    
    Dim currentRng, anchorRng As Range
    
    'I2, I3, I4....etc till the loop hits 'lastRow'
    Set currentRng = Range("I" & i)
    
    'K2, K3, K4....respective to currentRng
    Set anchorRng = Range("I" & i)
    
    Set dm = Range("A" & i)
    Set title = Range("B" & i)
    
    'Add Hyperlink
    currentRng.Hyperlinks.Add Anchor:=anchorRng, _
        Address:=url & dm.Value2, _
        ScreenTip:="SharePoint Demand Mangement", _
        TextToDisplay:=dm.Value2 & " - " & title.Value2
Next i
 
End Sub




Public Function GetLastRow(incomingRng As String)
    GetLastRow = Range(incomingRng).End(xlDown).Row
End Function

Display More

dsmith616 · Apr 28th 2016

Re: Add Hyperlinks Dynamically

I'm going to include the code that I "attempted" along with a data sample to see if that helps.

I receive an error on the currentRng and anchorRng. Not sure what else to try.

Code

Option Explicit






Sub Macro1()
'
' Macro1 Macro
'




Dim ControlFind As String
ControlFind = "WebAddress"
Dim LinkRng As Range
Set LinkRng = Cells.Find(What:=ControlFind)




Dim url As String
url = "http://intranetamericas.cshare.net/us/cts/SLS/SLSProjects/Lists/Development%20Requirement/DispForm.aspx?ID="








'This will go to cell I2, and get the last row
Dim lastRow As Long




lastRow = GetLastRow.Offset(0, 1)
MsgBox ("The last row is I" & lastRow)




Dim i As Integer
For i = 2 To lastRow
    
    Dim currentRng As Range
    Dim anchorRng As Range
    
    
    
    'I2, I3, I4....etc till the loop hits 'lastRow'
[COLOR=#ff0000][B]Set currentRng = (lastRow & i)[/B][/COLOR]
    
    'K2, K3, K4....respective to currentRng
[COLOR=#ff0000][B]Set anchorRng = (lastRow & i)[/B][/COLOR]
    
    Dim dm As Range
    Dim title As Range
    Set dm = Range("A" & i)
    Set title = Range("B" & i)
    
    'Add Hyperlink
    currentRng.Hyperlinks.Add Anchor:=anchorRng, _
        Address:=url & dm.Value2, _
        ScreenTip:="SharePoint Demand Mangement", _
        TextToDisplay:=dm.Value2 & " - " & title.Value2
Next i
 
End Sub












'
'    Cells.Find(What:="WebAddress", After:=ActiveCell, LookIn:=xlFormulas, _
'        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
'        MatchCase:=False, SearchFormat:=False).Activate
















Public Function GetLastRow(LinkRng As String)
    GetLastRow = Range(LinkRng).End(xlDown).Row
End Function

Display More

Participate now!

Share