Small edit to my existing working code

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
5,199
Office Version
  1. 2007
Platform
  1. Windows
Morning,
I have some customers of which i need to hyperlink to there respective jpg photo.
I have the existing working code shown below which allows me to select the customer, run the code & then that customer is now hyperlink to its own jpg photo.
So customer TOM JONES 001 is now hyperlinked to photo in folder TOM JONES 001.jpg
This code is great if i only need to select the odd one or two but at present i have about 200 etc.

So can we edit the existing code so when its run it will apply the hyperlink to each customer automatically.
There are some customers names in this column that doesnt require a hyperlink & obviously there isnt a jpg photo in the folder for them.


Some info for you to assist.

Worksheet called POSTAGE
Customers names are in column B
Path to photos is EBAY%20CUSTOMERS%20PHOTOS\


VBA Code:
Private Sub Hyperlink999_Click()
 Const FILE_PATH As String = "C:\Users\Ian\Desktop\REMOTES ETC\DR\EBAY CUSTOMERS PHOTOS\"
        If ActiveCell.Column = Columns("B").Column Then
          
        If Len(Dir(FILE_PATH & ActiveCell.Value & ".jpg")) Then
        ActiveCell.Hyperlinks.Add Anchor:=ActiveCell, Address:=FILE_PATH & ActiveCell.Value & ".jpg"
        MsgBox "HYPERLINK WAS SUCCESSFUL.", vbInformation, "POSTAGE SHEET HYPERLINK MESSAGE"
        End If
        
        Else
        MsgBox "PLEASE SELECT A CUSTOMER FIRST TO HYPERLINK THE PHOTO.", vbCritical, "POSTAGE SHEET HYPERLINK MESSAGE"
        Exit Sub
        End If
        
        If Dir(FILE_PATH & ActiveCell.Value & ".jpg") = "" Then
        If MsgBox("THERE IS NO PHOTO FOR THIS CUSTOMER" & vbNewLine & "WOULD YOU LIKE TO OPEN THE PHOTO FOLDER ?", vbYesNo + vbCritical, "HYPERLINK CUSTOMER PHOTO MESSAGE.") = vbYes Then
        CreateObject("Shell.Application").Open ("C:\Users\Ian\Desktop\REMOTES ETC\DR\EBAY CUSTOMERS PHOTOS\")
        End If

    
    End If
    
End Sub


Have a nice day
 

Excel Facts

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand
To put the link to all the cells in column B starting in cell B2:

VBA Code:
Private Sub Hyperlink999_Click()
  Const sPath As String = "C:\Users\Ian\Desktop\REMOTES ETC\DR\EBAY CUSTOMERS PHOTOS\"
  Dim sFile As String, i As Long
  With Sheets("POSTAGE")
    For i = 2 To .Range("B" & Rows.Count).End(3).Row
      sFile = sPath & .Range("B" & i).Value & ".jpg"
      If Len(Dir(sFile)) Then
        .Range("B" & i).Hyperlinks.Add Anchor:=.Range("B" & i), Address:=sFile
      End If
    Next
  End With
End Sub
 
Upvote 0
Many thanks worked a treat.

Hope you are well with this current situation we have.
 
Upvote 0
Thank you very much, I'm fine, I also hope that you and your family are well!
 
Upvote 0

Forum statistics

Threads
1,213,527
Messages
6,114,140
Members
448,551
Latest member
Sienna de Souza

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top