Creating a hyperlink with a macro

Hello Dror,

This macro creates a hyperlink to the cell of the user's choosing, and then asks to create a backward hyperlink.

'Written: November 18, 2007
'Author: Leith Ross
'Summary: Create a hyperlink to a cell of the user's choosing, and ask
'         to create a hyperlink back to the first hyperlink.

Sub Link2CellAndBack()

  Dim Answer As Variant
  Dim FirstAddx As String
  Dim LinkCell As Range
  Dim Prompt As String
  Dim SubAddx As String
  Dim Title As String
    
    Title = "Hyperlink Cells"
    Prompt = "Select the cell you want to hyperlink to, and click OK." & vbCrLf _
           & vbLf _
           & "You will then be asked if you want to create a link back" & vbCrLf _
           & "to the first hyperlink."
    FirstAddx = ActiveCell.Parent.Name & "!" & ActiveCell.Address
       
    On Error Resume Next
      Set LinkCell = Application.InputBox( _
          Prompt:=Prompt, _
          Title:=Title, _
          Default:=ActiveCell.Address, _
          Type:=8)
     'User selected Cancel Button
      If Err.Number = 424 Then Exit Sub
    On Error GoTo 0
    
   'Create the first Hyperlink
    SubAddx = LinkCell.Parent.Name & "!" & LinkCell.Address
    LinkCell.Hyperlinks.Add Anchor:=ActiveCell, Address:="", _
                            SubAddress:=SubAddx, _
                            TextToDisplay:=ActiveCell.Text
                            
     'Ask to create a Backward Hyperlink
      Answer = MsgBox(Prompt:="Do you want to create a backward link?", _
                      Buttons:=vbInformation + vbYesNo + vbDefaultButton2, _
                      Title:="Hyperlink Back")
        If Answer = vbYes Then
           LinkCell.Hyperlinks.Add Anchor:=LinkCell, Address:="", SubAddress:=FirstAddx
        End If
    
End Sub

Sincerely,
Leith Ross

WOW !!!! I can't thank you enough. You are a life saver.
I'll give it a test run later on today (I've got to run now... )
All the best,
Dror