Auto Hyperlink

[ateebali]

I have a workbook name "TCS" I want a vb code which apply on sheet1
It has range A2:A50 and have names in each cell
same name files are available on this sub folder;
Thisworkbook.path/Backup

For example, File name ABC on cell A1 should be hyperlink with file "ABC.xls" in folder
Cell A2 named XYZ should be hyperlink with file "XYZ.xlsb"

 

[Yongle]

try this

Place in a standard module in file TCS

Sub AddLinks()
    Application.ScreenUpdating = False
    On Error Resume Next
    Dim cel As Range, fPath As String, x As Integer, f As Object, fldr As Object, FSO As Object
    Dim celName As String, matchName As String
    fpath = ThisWorkbook.Path & "\Backup"
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set fldr = FSO.GetFolder(fPath)
        For Each cel In Sheets("Sheet1").Range("A2:A50")
            celName = cel.Value
            For Each f In fldr.Files
                matchName = Left(f.Name, InStrRev(f.Name, ".") - 1)
                If celName = matchName Then
                    ActiveSheet.Hyperlinks.Add cel, f.Path
                    Exit For
                End If
            Next f
        Next cel
End Sub

 

[ateebali]

Thanks this works fine

 

[Yongle]

thanks for the feedback