Using VBA to insert Hyperlinks

[jlrobinson]

I have a macro that takes a Template sheet and creates copies of it according to a List sheet, then populates the forms from data located in the List sheet. That part is working fine.

The issue I'm having is inserting hyperlinks from the copied sheets back to the List sheet to make navigation easier, as there are many forms to be created.
I tried using the hyperlink function as a formula, but I couldn't get that working. Other workbooks it works fine but this one throws a warning "some files contain viruses, are you sure you want to open the link" then when you say yes it throws an error "an unexpected error occurred". I've given up on that path.

Now I'm trying the vba method Hyperlink.add, and it almost works.

The code I'm using to try to add a hyperlink on cell B2 of the Copied sheet to the List sheet:

Sheets("Copied").Hyperlinks.Add Anchor:=Sheets("Copied").Range("B2"), Address:="", SubAddress:="'List'!A1", TextToDisplay:= "Link"

This code executes fine, but throws an invalid reference error when trying to follow the link.
Right clicking and editting the link shows its made the link to A1 of the Copied sheet instead of the List sheet.

 

[Jeffrey Mahoney]

If you want to avoid using hyperlinks, here is another method. I personally think that hyperlinks aren't stable; they fail me enough times where I can't depend on them.

This will open a workbook, a web link, any other files or folders.

'Add this to a SHEET Module. Change this: Range("ChckLst_Tbl[Hyperlink]") to whatever column you want

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim i As Range
    Dim R As Range
    Dim Cel As Range
    Dim HyperlinkStr As String
    Dim FileName As String
    Dim Pars As Variant
    Dim PW As String
    Dim PWT As String
    Dim Parms As String
    

    Set R = Range("ChckLst_Tbl[Hyperlink]")
    Set i = Intersect(R, Target)
    If Not i Is Nothing Then                  'Hyperlink column
      HyperlinkStr = i.Value
      If HyperlinkStr <> "" Then
        Cancel = True
        Pars = Split(HyperlinkStr, ",")
        On Error Resume Next
        HyperlinkStr = Trim(Pars(0))
        PW = Trim(Pars(1))
        PWT = Trim(Pars(2))
        Parms = Trim(Pars(3))
        On Error GoTo 0
        
        OpenPathFile HyperlinkStr, PW, PWT, Parms
        
      End If
    End If
    
    
End Sub

Add this to a Standard Module

'Providing a password assumes that you want to open a workbook
'PWType = "PW" then Normal password to open
'PWType = "WRPW then WriteResPassword; WriteReserved = Read Only until Password is entered
'Parms = command line parameters passed through shell
'  /r = open in Read Only
'  /e = Prevents startup screen and new workbook
'  /s = Safe Mode
'  /x = Starts Excel in new thread
'PathFile can be url; any string with 'http'
'PathFile can be a folder; cannot contain file extension
'PathFile can be a non Excel file; Word, PDF ...
Sub OpenPathFile(PathFile As String, Optional PW As String, Optional PWType As String, Optional Parms As String)

  Dim PF As Variant
  Dim WBBool As Boolean
  Dim Ext As String
  Dim WB As Workbook
  Dim LastPeriod As Long
  Dim Q As String
  Dim aStr As String
  
  If PathFile = "" Then Exit Sub
  LastPeriod = InStrRev(PathFile, ".")
  If LastPeriod > 0 Then Ext = Mid(PathFile, LastPeriod, 100)
  
  Application.StatusBar = "Opening: " & PathFile
  DoEvents
  On Error Resume Next
  If PW <> "" Or Ext = ".xlsm" Or Ext = ".xlsx" Or Ext = ".xls" Or Ext = ".xlsb" Then   'Excel Workbook
    If PW <> "" Then
      Select Case UCase(PWType)
        Case "PW"
          Set WB = Workbooks.Open(PathFile, UpdateLinks:=True, Password:=PW)
        Case "WRPW"
          Set WB = Workbooks.Open(PathFile, UpdateLinks:=True, WriteResPassword:=PW)
      End Select
    ElseIf Parms = "" Then
      Set WB = Workbooks.Open(PathFile)
    ElseIf Parms <> "" Then               'Parms like /x /e /s cannot be used with passwords
      Q = Chr(34)
      aStr = " " & Q & PathFile & Q & " " & Parms
      Application.DisplayAlerts = False
      Call Shell("Excel.exe" & aStr, vbNormalFocus)
    End If
  
  'URL
  ElseIf InStr(PathFile, "http") Then
    ThisWorkbook.FollowHyperlink PathFile
  
  'Non Excel File
  ElseIf InStr(PathFile, ":") And Len(PathFile) - InStrRev(PathFile, ".") < 6 Then
    PF = PathFile & vbNullString
    CreateObject("Shell.Application").Open PF
      
  'Normal Folder or network server folder; no file extension
  ElseIf (InStr(PathFile, ":\") Or InStr(PathFile, "\\")) And Len(PathFile) - InStrRev(PathFile, ".") > 5 Then
    Call Shell("Explorer.exe" & " " & PathFile, vbNormalFocus)
  End If
  On Error GoTo 0
  Application.OnTime Now + TimeValue("00:00:03"), "TimerEnd", Schedule:=True

End Sub

Sub TimerEnd()
Application.StatusBar = False
End Sub