View Full Version : [SOLVED] Create an Hyperlink if cell value and file name match

11-07-2016, 11:43 AM
Hi guys, I got a little doubt about if this can be possible, I need to make a macro that check the code in a range and check the file name in a folder, and if that match, then create an hyperlink, here is an example.

Kenneth Hobs
11-07-2016, 01:45 PM
1. What is the parent folder name?
2. What is the file extension name?

11-07-2016, 01:57 PM
There are 1 folder for the images (JPEG):

P:\Reparto\3.- Seguimiento\Seguimiento Diario x Ruta\Barinas\Mapas

and one main folder for the (xlsx) file.

P:\Reparto\3.- Seguimiento\Seguimiento Diario x Ruta\Pais

But I can fix the Dir later I think I can handle it.

Kenneth Hobs
11-07-2016, 08:38 PM
I wasn't sure what you wanted so I made this to check for the target cell to be "", or a jpg file, or an xlsx file, in separate paths for each. Using this method, there is no need for iterating files by a method like Dir().

Right click the sheet's tab, View Code, and paste.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range, r As Range, jpgPath As String, xlsxPath As String
Dim hCell As Range, fn As String, q As String
Dim glb_origCalculationMode As Integer
Dim fnJPG As String, fnXLSX As String

Set r = Intersect(Target, Columns("A"))
If r Is Nothing Then Exit Sub

jpgPath = "c:\myfiles\excel\pics\" 'Path to JPGs
'If Not fe(jpgPath) Then Exit Sub

xlsxPath = "c:\mfiles\excel\" 'Path to XLSXs
'If Not fe(xlsxPath) Then Exit Sub

q = """"
On Error GoTo EndSub
glb_origCalculationMode = Application.Calculation
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
.Cursor = xlWait
.StatusBar = "Adding hyperlinks..."
.EnableCancelKey = xlErrorHandler
End With

For Each c In r
Set hCell = c.Offset(, 1)
fn = c.Value
fnJPG = jpgPath & fn & ".jpg"
fnXLSX = xlsxPath & fn & ".xlsx"
Select Case True
Case fn = ""
hCell.Value = ""
Case FE(fnJPG)
hCell.Formula = "=HYPERLINK(" & q & fnJPG & q & _
"," & q & fn & q & ")"
Case FE(fnXLSX)
hCell.Formula = "=HYPERLINK(" & q & fnXLSX & q & _
"," & q & fn & q & ")"
Case Else
End Select
Next c

With Application
.Calculation = glb_origCalculationMode
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
.CalculateBeforeSave = True
.Cursor = xlDefault
.StatusBar = False
.EnableCancelKey = xlInterrupt
End With
End Sub

In the code above, change the Column to Intersect to suit. Change the jpgPath and xlsxPath to suit.

Add this to a Module or use it as a Private Sub in the sheet.

Function FE(aString) As Boolean
FE = (Len(Dir(aString)) <> 0)
End Function

11-08-2016, 01:47 PM
Sorry, but I don't even can execute it.

Maybe I just didn't explain it good, but is easy, all I want to do for example is check "IF" A9 value match with file name, if that match or is true, then create an hyperlink in the same row of A9 but column B, if not is = or doesn't match then continue with the other cell and file.

Here is another better image for example.

Kenneth Hobs
11-08-2016, 03:10 PM
Do you understand how the worksheet's Change event works? Change a value in column A and if JPG or XLSX file is found in their respective folders, the hyperlink is put into column B. If column A="" then no hyperlink is shown in B. I guess if you want JEPG files then change the .jpg in my code to .jpeg. You can do both .jpg and .jpeg using my method though. Just add another Case.

I code this to not be a one off event like some do. Change all, some, or just one in column A and column B gets the hyperlink. Try doing one first. Once it works, cut and paste back all of column A from A2 down to update.

As I said, you must also change the jpgPath and xlsxPath values to your paths.

It is more helpful to post an example file rather than images. Click the Go Advanced button in lower right of a reply and then the paperclip icon on the toolbar of Manage Attachments link at end of reply box.

11-08-2016, 03:37 PM
Finally I understand how it works, awesome!, thanks you very much for your time and dedication and sorry for my mistake.

This is finally Solved.