Add Hyperlink to Found Value

[Norske77]

I have the following code that is searching a specified folder for a specific string. When found it is returning data like workbook name, worksheet name, cell... to a summary page. I would also like to add a hyperlink to the exact cell in the workbook and worksheet that it was found in but I am struggling. Any help would be greatly appreciated.

Sub SearchFolders()    Dim Fso As Object
    Dim Fld As Object
    Dim RngSearch As Range
    Dim StrPath As String
    Dim StrFile As String
    Dim Out As Worksheet
    Dim Wb As Workbook
    Dim Wk As Worksheet
    Dim Row As Long
    Dim Found As Range
    Dim StrAddress As String
    Dim FileDialog As FileDialog
    Dim Update As Boolean
    Dim Count As Long
    On Error GoTo ErrHandler
    Set FileDialog = Application.FileDialog(msoFileDialogFolderPicker)
    FileDialog.AllowMultiSelect = False
    FileDialog.Title = "Select a forlder"
    If FileDialog.Show = -1 Then
        StrPath = FileDialog.SelectedItems(1)
    End If
    If StrPath = "" Then Exit Sub
    Set RngSearch = ActiveWorkbook.Worksheets("Sheet1").Range("B2:B2")
    Update = Application.ScreenUpdating
    Application.ScreenUpdating = False
    Set Out = Worksheets.Add
    Row = 1
    With Out
        .Cells(Row, 1) = "Workbook"
        .Cells(Row, 2) = "Worksheet"
        .Cells(Row, 3) = "Cell"
        .Cells(Row, 4) = "Text in Cell"
        .Cells(Row, 5) = "Coverage Effective Date"
        Set Fso = CreateObject("Scripting.FileSystemObject")
        Set Fld = Fso.GetFolder(StrPath)
        StrFile = Dir(StrPath & "\*.xlsx*")
        Do While StrFile <> ""
            Set Wb = Workbooks.Open(Filename:=StrPath & "\" & StrFile, UpdateLinks:=0, ReadOnly:=True, AddToMRU:=False)
            For Each Wk In Wb.Worksheets
                If Wk.Name = "Sheet1" Then
                Set Found = Wk.Range("I1:I" & Wk.UsedRange.Cells.SpecialCells(xlCellTypeLastCell).Row).Find(RngSearch)
                If Not Found Is Nothing Then
                    StrAddress = Found.Address
                End If
                Do
                    If Found Is Nothing Then
                        Exit Do
                    Else
                        Count = Count + 1
                        Row = Row + 1
                        .Cells(Row, 1) = Wb.Name
                        .Cells(Row, 2) = Wk.Name
                        .Cells(Row, 3) = Found.Address
                        .Cells(Row, 4) = Found.Value
                        .Cells(Row, 5) = Found.Offset(0, 11).Value
                    End If
                    Set Found = Wk.Cells.FindNext(After:=Found)
                Loop While StrAddress <> Found.Address
                Exit For
                End If
            Next
            Wb.Close (False)
            StrFile = Dir
        Loop
        .Columns("A:E").EntireColumn.AutoFit
    End With
    MsgBox Count & "cells have been found"
ExitHandler:
    Set Out = Nothing
    Set Wk = Nothing
    Set Wb = Nothing
    Set Fld = Nothing
    Set Fso = Nothing
    Application.ScreenUpdating = Update
    Exit Sub
ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
End Sub