How to add Hyperlink to Cell Changes

[coreyalaurence39]

Dim vOldVal 'Must be at top of module

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim strUserName As String
Dim xFormula As Boolean
Dim xDate As Boolean
Dim xHead As Range
Dim xTitle As Range

Set xHead = Sheets("Track_Changes").Range("B3:H3")
strUserName = Application.UserName

On Error Resume Next
If Target.Cells.Count > 1 Then Exit Sub
On Error Resume Next
    
With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With
    
    If IsEmpty(vOldVal) Then vOldVal = "[empty cell]"
    xFormula = Target.HasFormula
    xDate = IsDate(Target)

    With Sheets("Track_Changes")
        .Unprotect Password:="Password"
      
                If .Range("B2") = vbNullString Then
                    xHead = Array("DATE OF CHANGE", "TIME OF CHANGE", "SHEET NAME", "CELL CHANGED", "CHANGE BY", "OLD VALUE", "NEW VALUE")
                Sheets("Track_Changes").Columns(1).ColumnWidth = 3
                
                .Range("B1").Value = "Track Changes"
                .Range("B1").Font.Size = 18
                                
                With xHead
                    .Interior.Color = RGB(30, 139, 195)
                    .Font.Color = vbWhite
                    .Font.Bold = True
                End With

                With xHead.Borders(xlInsideVertical)
                    .Color = vbWhite
                    .Weight = xlMedium
                End With
                End If
            
        
        With .Cells(.Rows.Count, 2).End(xlUp)(2, 1)
                    .Borders(xlInsideVertical).Color = RGB(255, 191, 191)
                    .Borders(xlInsideVertical).Weight = xlMedium
                    
                    .Value = Date
                    .Offset(0, 1) = Format(Now, "hh:mm:ss")
                    .Offset(0, 2) = Target.Parent.Name
                    .Offset(0, 3) = Target.Address
                    .Offset(0, 4) = strUserName
                    .Offset(0, 5) = vOldVal
                  
                    With .Offset(0, 6)
                        If xFormula = True Then
                            .ClearComments
                            .AddComment.Text Text:="Cell is bold as value contains a formula"
                        End If
                        If xDate = True Then
                            .NumberFormat = "dd/mm/yyyy"
                        End If
                        .Value = Target
                        .Font.Bold = xFormula
                        If IsEmpty(Target) Then .Value = "[empty cell]"
                    End With
                    
            End With

            .Cells.Columns.AutoFit
            .Cells.Columns.HorizontalAlignment = xlLeft
            
n = Sheets("Track_Changes").Range("B:B").Cells.SpecialCells(xlCellTypeConstants).Count - 1
With Sheets("Track_Changes").Range("B4:H" & n + 2)
        .Borders(xlInsideHorizontal).Color = RGB(30, 139, 195)
        .Borders(xlInsideHorizontal).Weight = xlThin
        .Borders(xlInsideVertical).Color = RGB(200, 200, 200)
        .Borders(xlInsideVertical).Weight = xlThin
End With
.Protect Password:="Password"
        End With
    vOldVal = vbNullString

    With Application
         .ScreenUpdating = True
         .EnableEvents = True
    End With

On Error GoTo 0

End Sub



Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

On Error Resume Next
If Selection.Cells.Count > 1 Then Exit Sub 'Avoid runtime error 7
    vOldVal = Target

End Sub

I have the above code and I would like to make the line of code .Offset(0, 3) = Target.Address to be a hyperlink that when clicked will take you to that cell on the sheet. Can someone assist me with this.