Create Hyperlink In Email From Relative Cell Value

[wguidry]

I need to create a hyperlink from the value in a cell. It is a URL that will be populated in an email.

It is located in the code below at:
Msg = Msg & "Please click this link to view the map: " & vbCrLf
Msg = Msg & ActiveCell.Offset(0, -12).Value & vbCrLf & vbCrLf

I want ActiveCell.Offset(0, -12).Value to be converted to a hyperlink instead of showing only as plain text.

Any thoughts?
Thanks,

--------------------

Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
Sub Send_R1()
Dim Email As String, Subj As String
Dim Msg As String, URL As String
' On Error GoTo HandleErrors
'HandleErrors:
'Exit Sub
If ActiveCell.Offset(0, 3).Value = "REMOVE PUB. OR SEND TERR." And ActiveCell.Value = "SEND" Then
If MsgBox("Are you sure you want to email Territory " & ActiveCell.Offset(0, -13).Value & " to " & ActiveCell.Offset(0, -5).Value & " " & ActiveCell.Offset(0, -4).Value & " " & ActiveCell.Offset(0, -3).Value & "?", vbYesNo, "Confirm") = vbYes Then
ActiveCell.Offset(0, -1).Value = Date
Email = ActiveCell.Offset(0, -2).Value
Subj = "RE: Your Dickinson Cong. Territory Request"
Msg = Msg & "Hello " & ActiveCell.Offset(0, -5).Value & " " & ActiveCell.Offset(0, -3).Value & ". Thank you for your Territory request." & vbCrLf & vbCrLf
Msg = Msg & "You have been assigned Territory:" & vbCrLf
Msg = Msg & ActiveCell.Offset(0, -13).Value & vbCrLf & vbCrLf
Msg = Msg & "Please click this link to view the map: " & vbCrLf
Msg = Msg & ActiveCell.Offset(0, -12).Value & vbCrLf & vbCrLf
Msg = Msg & "This Territory will expire on " & ActiveCell.Offset(0, 2).Value & "." & vbCrLf & vbCrLf
Msg = Msg & "Your Brothers," & vbCrLf
Msg = Msg & "Dickinson Congregation"
Subj = Application.WorksheetFunction.Substitute(Subj, " ", "%20")
Msg = Application.WorksheetFunction.Substitute(Msg, " ", "%20")
Msg = Application.WorksheetFunction.Substitute(Msg, vbCrLf, "%0D%0A")
URL = "mailto:" & Email & "?subject=" & Subj & "&body=" & Msg
ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString, vbNormalFocus
Application.Wait (Now + TimeValue("0:00:05"))
Application.SendKeys "{Tab}{Tab}{Tab}{Tab}{Tab}^{End}{Return}{Return}^v"
Application.SendKeys "%s"
MsgBox "The Territory Has Been Sent"
ActiveSheet.Cells(ActiveCell.Row, 1).Select
ActiveCell.Offset(0, 21).Select
Selection.Copy
ActiveCell.Offset(0, -1).Select
ActiveSheet.Paste
ActiveCell.Offset(0, 2).Select
Selection.Copy
ActiveCell.Offset(0, -1).Select
ActiveSheet.Paste
ActiveCell.Offset(0, -8).Select
Selection.Copy
ActiveCell.Offset(0, 9).Select
ActiveSheet.Paste
End If
End If
End Sub

 

[frank_AL]

Try this:
Change "Click Here" to whatever label you want on the Hyperlink.
I found this solution at the following link:

Msg = Msg & ActiveCell.Offset(0, -12).Value  & """ >Click Here& vbCrLf & vbCrLf