Macro Hyperlink Code to File

[ineedsomehelp89]

I have an excel spreadsheet with over 500 rows and 10 columns. One of the columns contains filenames such as 1-14.PDF I also have a folder called E:\Pinnacle\This\Here which contains PDFs such as 1-14 I need a macro code to automatically turn each cell that has text like 1-14.PDF into a hyperlink to the actual file 1-14 in the folder. This needs to automatically do this for the whole column M. I have looked all over this board and internet for how to do it and cannot find it. I have found bits and pieces from codes like it but cannot seem to get it to work. Please help. This is my first spreadsheet like this but will be doing this on a daily basis for atleast a month. You would save me so much time.

 

[Gary McMaster]

I believe you should be able to set the "Hyperlink Base" (see Excel help) to the folder you mentioned and then fill the "Hyperlink" function down the column adjacent to the filename using the filename as the argument to the function.

Gary

 

[ineedsomehelp89]

We need it to be on that column

The end user will not understand if there are two columns with the filenames but only one of them is a hyperlink. Thank you for the help so far.

 

[Gary McMaster]

You can hide the column that is not linked or possibly even put the filenames on a different sheet and hide the second sheet.

Gary

 

[Gary McMaster]

Here's some code you can try if you're not satisfied with the hyperlink function.

Gary

In a standard module:

Public Sub Links()

Dim lLastRow As Long
Dim oTarget As Range
Dim oCell As Range
Dim sPath As String

'Change path to suit - trailing backslash required
sPath = "E:\Pinnacle\This\Here\"

'Last used row in column M
lLastRow = ActiveSheet.Range("M" & Rows.Count).End(xlUp).Row ' Change column to suit

Set oTarget = ActiveSheet.Range("M2:M" & lLastRow) ' Change column to suit

oTarget.Hyperlinks.Delete

For Each oCell In oTarget
    'Check for existing file
    If Dir(sPath & oCell.Text) <> "" Then
        ActiveSheet.Hyperlinks.Add oCell, sPath & oCell.Text, , , oCell.Text
    Else
        'Red interior if file not found
        oCell.Interior.ColorIndex = 3
    End If
Next oCell

End Sub