Statement to create excel vba hyperlink throws Run-time '1004' Error

Question

So I have had a couple of questions I've asked regarding excel VBA, and I appreciate you all bearing with me as I stumble through learning about all this. Your answers have been a tremendous help and learning experience.

So far, I have a subroutine whose main responsibility is to write all of the values collected through a user form with various validations and dynamic comboboxes. My final task is to get this Subroutine to assign a hyperlink to the location selected by an earlier loop. But with my current syntax, I'm getting a "run-time error '1004' method '_default' of object 'range' failed". Some research proved that the cell coordinates require a .address property after them in order to avert this error, but it did not resolve the issue. The code is below:

    Option Explicit
    Dim cnt As Integer
    Dim i As Long, rowOff As Long
    Dim dateSel As String
    Dim timeSel As String
    Dim branch As String
    Dim sht As Worksheet
    Dim cel As Range
    Dim matchingHeader As Range

    Public Sub UserForm_Initialize()
        'clear form
        BranchBox.Value = ""
        DateBox.Value = ""
        TimeBox.Value = ""

        'populate sheet names from each branch
        For Each sht In ActiveWorkbook.Sheets
          If sht.Name = "ApplicantInfo" Then
            'Do Nothing
          Else
            Me.BranchBox.AddItem sht.Name
          End If
        Next sht
    End Sub

    Public Sub HoldButton_Click() 'revisit... throwing Time message box regardless what's selected
        If TimeBox.Value <> "" Then
            If DateBox.Value <> "" Then
                If BranchBox.Value <> "" Then
                    sht.Cells(rowOff, i).Value = "-"
                    'Save workbook
                Else
                    MsgBox "You must select a branch for your appointment"
                End If
            Else
                MsgBox "You must select a date for your appointment"
            End If
        Else
            MsgBox "You must select a time for your appointment"
        End If
    End Sub

    Private Sub ResetButton_Click()
        FirstName.Value = ""
        LastName.Value = ""
        EMail.Value = ""
        Phone.Value = ""
        Skills.Value = ""
        'BranchBox.Value = "" throws error
        DateBox.Value = ""
        TimeBox.Value = ""
    End Sub

    Private Sub ScheduleButton_Click()
        Dim row As Long, column As Long
        Dim linkDisplay As String
        'test for RowOff and i <> 0
        If IsNull(BranchBox) = True Then
            MsgBox "Select a branch for you interview before you click schedule"
        Else
            If IsNull(DateBox) = True Then
                MsgBox "Select a date for you interview before you click schedule"
            Else
                If IsNull(TimeBox) = True Then
                    MsgBox "Select a time for you interview before you click schedule"
                Else
                    'find first empty row in applicant profile tab.
                    'Insert applicant information in free row
                    'parse applicant name as a link to found free row above
                    'replace "-" placeholder for held appointment with applicant name as a link

                    Call GetFirstEmptyRow
                    'write selected values into row
                    Dim InfoRow As Integer
                    InfoRow = ActiveCell.row
                    ActiveCell.Value = ActiveCell.Offset(-5, 0).Value + 5
                    ActiveCell.Offset(0, 1).Select
                    ActiveCell.Value = LastName.Value
                    ActiveCell.Offset(0, 1).Select
                    ActiveCell.Value = FirstName.Value
                    ActiveCell.Offset(0, 1).Select
                    ActiveCell.Value = EMail.Value
                    ActiveCell.Offset(0, 1).Select
                    ActiveCell.Value = Phone.Value
                    ActiveCell.Offset(0, 1).Select
                    ActiveCell.Value = Skills.Value
                    ActiveCell.Offset(0, 1).Select
                    ActiveCell.Value = BranchBox.Value
                    ActiveCell.Offset(0, 1).Select
                    ActiveCell.Value = DateBox.Value
                    ActiveCell.Offset(0, 1).Select
                    ActiveCell.Value = TimeBox.Value

                    branch = BranchBox.Value
                    Set sht = ActiveWorkbook.Worksheets(branch)
                    dateSel = DateBox.Value
                    timeSel = TimeBox.Value

                    'scan for selected date
                    For i = 2 To sht.Rows.Count
                        Set cel = sht.Cells(i, 1)
                        If cel.Value = dateSel Then
                            column = i
                            Exit For
                        End If
                    Next i

                    'Scan for selected time
                    For i = 2 To sht.Columns.Count
                        Set cel = sht.Cells(1, i)
                        If CStr(cel.Value) = timeSel Then
                            row = i
                            Exit For
                        End If
                    Next i

                    linkDisplay = LastName.Value & ", " & FirstName.Value
'This is the error 
                    sht.Hyperlinks.Add Anchor:=sht.Cells(row, column).Address, Address:="", SubAddress:=ActiveWorkbook.Worksheets("ApplicantInfo").Cells(InfoRow, 1).Address, TextToDisplay:=linkDisplay



                    'end of validations
                End If
            End If
        End If
    End Sub
    Public Sub GetFirstEmptyRow()
        Set sht = ActiveWorkbook.Worksheets("ApplicantInfo")
        sht.Activate
        Range("A1").Select
        Do
            If IsEmpty(ActiveCell) = False Then
                ActiveCell.Offset(1, 0).Select
            End If
        Loop Until IsEmpty(ActiveCell) = True

    End Sub
    Public Sub Save()

    End Sub
    Public Sub TimeBox_Change()

    End Sub

    Public Sub BranchBox_Change()
        'clear Date Box Values
        For i = DateBox.ListCount - 1 To 0 Step -1
            DateBox.RemoveItem i
        Next i
        'clear Time Box Values
        i = 0
        For i = TimeBox.ListCount - 1 To 0 Step -1
            TimeBox.RemoveItem i
        Next i
        'reset i to 0
        i = 0
        'populate dates
        Me.DateBox.List = Worksheets(BranchBox.Value).Range("A2:A31").Value
    End Sub
    Public Sub DateBox_Change()
        branch = BranchBox.Value
        Set sht = ActiveWorkbook.Worksheets(branch)
        dateSel = DateBox.Value

        'Get Row to scan
        For i = 2 To sht.Rows.Count
            Set cel = sht.Cells(i, 1)
            If cel.Value = dateSel Then
                rowOff = i
                Exit For
            End If
        Next i

        'Scan selected row for blank cells
        For i = 2 To sht.Columns.Count
            Set cel = sht.Cells(rowOff, i)
            If CStr(cel.Value) = "" Then
                Set matchingHeader = sht.Cells(1, i)
                TimeBox.AddItem matchingHeader.Text
            End If
        Next i
        Me.TimeBox.AddItem ("No Appointments Available")
    End Sub

This is the line which errors:

sht.Hyperlinks.Add Anchor:=sht.Cells(row, column).Address, _
                   Address:="", _
                   SubAddress:=ActiveWorkbook.Worksheets("ApplicantInfo") _
                                  .Cells(InfoRow, 1).Address, _
                   TextToDisplay:=linkDisplay

Help is much appreciated! Thanks in advance!

Answer 1

sht.Hyperlinks.Add Anchor:=sht.Cells(row, column), _
              Address:="", _
              SubAddress:="'ApplicantInfo'!" & Cells(InfoRow, 1).Address(False, False), _
              TextToDisplay:=linkDisplay

I'd typically use a utility method for this type of thing though.

E.g. something like:

Sub CreateHyperlink(FromCell As Range, ToCell As Range, Optional LinkText As String = "")
    Dim subAddr, txt

    subAddr = ToCell.Address(False, False)
    If FromCell.Worksheet.Name <> ToCell.Worksheet.Name Then
        subAddr = "'" & ToCell.Worksheet.Name & "'!" & subAddr
    End If

    txt = IIf(LinkText <> "", LinkText, FromCell.Value)
    If Len(txt) = 0 Then txt = "Go"

    With FromCell.Worksheet
        .Hyperlinks.Add Anchor:=FromCell, Address:="", _
                        SubAddress:=subAddr, TextToDisplay:=txt
    End With

End Sub