VBA Auto Add Hyperlink based on Cell Values when Data is updated

mielkew

mielkew

New member
Joined
Feb 18, 2018
Messages
6
Reaction score
0
Points
0
Excel Version(s)
2016
Hello Guys,

Can someone help me make a VBA code that will automatically add hyperlink to columns D & E. Given the information provided in Column A, B & C?

Also, I have several worksheet in one workbook, in this case the below data is from sheet name called "Drawing". I want the VBA code to automatically add in column D & E whenever the user hit the data refresh button, is it possible to define the exact worksheet in workbook where the VBA should run?

I have managed to do this in excel by Formula as per below, however, there are user which is less familiar in excel and unintentionally deleting the formula by mistake. I want the VBA code to insert hyperlink whenever data is available and add new hyperlink when new item/data is added in the list.

Column D = if(ColumnC="No Native File","No Native File",if(ColumnC="Void Confidential","Void",Hyperlink(ColumnC&ColumnA&ColumnB,"View File")
Column E = if(ColumnC="No Native File","",if(ColumnC="Void Confidential","",Hyperlink(ColumnC&ColumnA,"Open Location")

File Name (Column A) - Drawing-0001
File Extension (Column B) - .pdf
File Path (Column C)- C:\Desktop\Test\
Hyperlink (Column D) - Text to display “View File”
File Location (Column E) - Text to display “Open Location”

Please see photo for sample data.

I use PowerQuery to load/update the data in the user template but the hyperlink is always my problem. Because sometime the user by mistake clicking inside the cell instead of clicking the text "View File" eventually deleting the formula by mistake. Please HELP ME guys.

Any help is very much appreciated.

IMG_0562.jpg


Sent from my iPhone using Tapatalk
 
try something along these lines to get you started:
Code: 
Sub blah()
Set DRange = Range("D2:D5")    '<<adjust this or determine extent programmatically.
DRange.Resize(, 2).Clear
For Each cll In DRange.Cells
  Select Case UCase(cll.Offset(, -1).Value)
    Case "NO NATIVE FILE"
      cll.Value = "No native File"
    Case "VOID CONFIDENTIAL"
      cll.Value = "Void"
    Case Else
      ActiveSheet.Hyperlinks.Add Anchor:=cll, Address:=cll.Offset(, -1) & cll.Offset(, -3) & cll.Offset(, -2), TextToDisplay:="View File"
      ActiveSheet.Hyperlinks.Add Anchor:=cll.Offset(, 1), Address:=cll.Offset(, -1) & cll.Offset(, -3), TextToDisplay:="Open Location"
  End Select
Next cll
End Sub
 
Last edited:
p45cal said:
try something along these lines to get you started:
Code: 
Sub blah()
Set DRange = Range("D2:D5")    '<<adjust this or determine extent programmatically.
DRange.Resize(, 2).Clear
For Each cll In DRange.Cells
  Select Case UCase(cll.Offset(, -1).Value)
    Case "NO NATIVE FILE"
      cll.Value = "No native File"
    Case "VOID CONFIDENTIAL"
      cll.Value = "Void"
    Case Else
      ActiveSheet.Hyperlinks.Add Anchor:=cll, Address:=cll.Offset(, -1) & cll.Offset(, -3) & cll.Offset(, -2), TextToDisplay:="View File"
      ActiveSheet.Hyperlinks.Add Anchor:=cll.Offset(, 1), Address:=cll.Offset(, -1) & cll.Offset(, -3), TextToDisplay:="Open Location"
  End Select
Next cll
End Sub
Click to expand...

Thanks for this code, should i create a module or put this code in each sheet? I have several sheets that varies the column location of file extension and file path. Also, how can i set the range to look into last row which is not blank?

Does this code will automatically add the hyperlink whenever data is added at the end of the table?

Sorry I really don’t have an idea regarding VBA code, I googled a lot but can’t get quite understand how the code works.

Thanks


Sent from my iPhone using Tapatalk
 
mielkew said:
Thanks for this code, should i create a module or put this code in each sheet?
Click to expand...
Put the code in a standard code module, rather than in sheet(s) code module(s). It doesn't matter whether you create a new standard module or you put it in an existing standard code module.



mielkew said:
I have several sheets that varies the column location of file extension and file path.
Click to expand...
If, on a given sheet, the relative positions of the columns are the same, it shouldn't be difficult to determine the extent programmatically (see comment on the first line of the code), both in terms of position on the sheet and the numbers of rows involved. However, if the relative positions of the columns is not the same there will very likely be ways to determine those positions programmatically (I would look first to the column headers to try and determine this). Should that prove impossible then I'll be asking whether the columns' positions remain constant in each given sheet, and whether the sheets in question are permanent ones.



mielkew said:
Also, how can i set the range to look into last row which is not blank?
Click to expand...
This can be done easily, especially if there is no data below the last row of data where you want to add hyperlinks.



mielkew said:
Does this code will automatically add the hyperlink whenever data is added at the end of the table?
Click to expand...
Not at the moment but it could be arranged.


Many of the answers above can be programmed, but I'm unwilling to start writing code without getting a very clear idea of what's in the workbook. Pictures of workbooks have very limited use. Supply an actual workbook which is as close as you can get to your actual workbook without exposing data you don't want to be in the public domain (you can change that data with some intelligent search/replace operations (not wholesale search/replace/delete operations)).
 
Having experimented with your file and adding the hyperlinks via VBA it was taking far too long (20 minutes) just for one sheet! Maybe it's because the links couldn't be resolved on my machine - dunno.
So I've reverted to refreshing the formulae - it's almost instant. Your main concern was people deleting the formulae; two things we can do here: (1) make replacing the formulae trivial, which is what the macros below do, and (2) you could also protect the cells by protecting the sheet with those cells locked and all the others unlocked. Tell me if you want to do (2) and I'll update the code.
The code:
Code: 
Sub IFC_All_RegisterLinksRefresh()
Range("IFC_All_Register[Hyperlink]").FormulaR1C1  = "=IF(LEFT([@[Folder Path]],1)=""\"",HYPERLINK([@[Folder  Path]]&[@[Document Reference Number]]&[@[File Format]],""View  File""),"""")"
Range("IFC_All_Register[File Location]").FormulaR1C1 =  "=IF(LEFT([@[Folder Path]],1)=""\"",HYPERLINK([@[Folder Path]],""Open  File Location""),[@[Folder Path]])"
End Sub

Sub All_SpecSectionsLinksRefresh()
Range("All_SpecSections[Latest  PDF File]").FormulaR1C1 = "=IF([@[Folder  Path]]="""","""",HYPERLINK([@[Folder Path]]&[@[New Document  Reference]]&"".pdf"",""Click to View""))"
Range("All_SpecSections[Latest  Track Version]").FormulaR1C1 = "=IF([@[Folder  Path]]="""","""",HYPERLINK([@[Folder Path]]&[@[New Document  Reference]]&"".pdf"",""Click to View""))"
Range("All_SpecSections[PDF  and Track Version File Location]").FormulaR1C1 = "=IF([@[Folder  Path]]="""","""",HYPERLINK([@[Folder Path]],""Open File Location""))"
Range("All_SpecSections[Accepted  Specs Hyperlink]").FormulaR1C1 = "=IF([@[Folder  Path.1]]="""","""",HYPERLINK([@[Folder Path.1]]&[@[New Document  Reference]]&"".pdf"",""Accepted""))"
Range("All_SpecSections[Accepted   Folder Location]").FormulaR1C1 = "=IF([@[Folder  Path.1]]="""","""",HYPERLINK([@[Folder Path.1]],""Accepted Folder  Location""))"
End Sub

Sub IFC_AcceptedLinksRefresh()
Range("IFC_Accepted[Hyperlink]").FormulaR1C1  = "=IF(LEFT([@[Folder Path]],1)=""\"",HYPERLINK([@[Folder  Path]]&[@[Document Reference Number]]&[@[File Format]],""View  File""),"""")"
Range("IFC_Accepted[File Location]").FormulaR1C1 =  "=IF(LEFT([@[Folder Path]],1)=""\"",HYPERLINK([@[Folder Path]],""Open  File Location""),[@[Folder Path]])"
End Sub
This will handle all the rows in a table, however many there happen to be.
 
Thank you so much, that sound perfect if we can protect it. However does the query will still be able to refresh? That's what I did earlier were I tried to protect the column where the formals are in but excel won't let the table refreshed.

Sent from my LYA-L29 using Tapatalk
 
On each of the sheets concerned, unlock all the cells on the sheet, then lock the cells in the columns containing the formulae you want to protect.
Then use this code instead:
Code: 
Sub IFC_All_RegisterLinksRefresh()
Range("IFC_All_Register").Parent.Protect Contents:=True, userinterfaceonly:=True

Range("IFC_All_Register[Hyperlink]").FormulaR1C1 = "=IF(LEFT([@[Folder Path]],1)=""\"",HYPERLINK([@[Folder Path]]&[@[Document Reference Number]]&[@[File Format]],""View File""),"""")"
Range("IFC_All_Register[File Location]").FormulaR1C1 = "=IF(LEFT([@[Folder Path]],1)=""\"",HYPERLINK([@[Folder Path]],""Open File Location""),[@[Folder Path]])"
End Sub

Sub All_SpecSectionsLinksRefresh()
Range("All_SpecSections").Parent.Protect Contents:=True, userinterfaceonly:=True

Range("All_SpecSections[Latest PDF File]").FormulaR1C1 = "=IF([@[Folder Path]]="""","""",HYPERLINK([@[Folder Path]]&[@[New Document Reference]]&"".pdf"",""Click to View""))"
Range("All_SpecSections[Latest Track Version]").FormulaR1C1 = "=IF([@[Folder Path]]="""","""",HYPERLINK([@[Folder Path]]&[@[New Document Reference]]&"".pdf"",""Click to View""))"
Range("All_SpecSections[PDF and Track Version File Location]").FormulaR1C1 = "=IF([@[Folder Path]]="""","""",HYPERLINK([@[Folder Path]],""Open File Location""))"
Range("All_SpecSections[Accepted Specs Hyperlink]").FormulaR1C1 = "=IF([@[Folder Path.1]]="""","""",HYPERLINK([@[Folder Path.1]]&[@[New Document Reference]]&"".pdf"",""Accepted""))"
Range("All_SpecSections[Accepted  Folder Location]").FormulaR1C1 = "=IF([@[Folder Path.1]]="""","""",HYPERLINK([@[Folder Path.1]],""Accepted Folder Location""))"
End Sub

Sub IFC_AcceptedLinksRefresh()
Range("IFC_Accepted").Parent.Protect Contents:=True, userinterfaceonly:=True

Range("IFC_Accepted[Hyperlink]").FormulaR1C1 = "=IF(LEFT([@[Folder Path]],1)=""\"",HYPERLINK([@[Folder Path]]&[@[Document Reference Number]]&[@[File Format]],""View File""),"""")"
Range("IFC_Accepted[File Location]").FormulaR1C1 = "=IF(LEFT([@[Folder Path]],1)=""\"",HYPERLINK([@[Folder Path]],""Open File Location""),[@[Folder Path]])"
End Sub
 
You must log in or register to reply here.
Back
Top