Results 1 to 8 of 8

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

  1. #1
    Neophyte mielkew's Avatar
    Join Date
    Feb 2018
    Posts
    4
    Articles
    0
    Excel Version
    2016

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



    Register for a FREE account, and/
    or Log in to avoid these ads!

    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.

    Click image for larger version. 

Name:	IMG_0562.jpg 
Views:	16 
Size:	10.8 KB 
ID:	8823


    Sent from my iPhone using Tapatalk

  2. #2
    Super Moderator p45cal's Avatar
    Join Date
    Dec 2012
    Posts
    1,523
    Articles
    0
    Excel Version
    365
    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 by p45cal; 2019-02-02 at 10:16 PM.

  3. #3
    Neophyte mielkew's Avatar
    Join Date
    Feb 2018
    Posts
    4
    Articles
    0
    Excel Version
    2016
    Quote Originally Posted by p45cal View Post
    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
    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

  4. #4
    Super Moderator p45cal's Avatar
    Join Date
    Dec 2012
    Posts
    1,523
    Articles
    0
    Excel Version
    365
    Quote Originally Posted by mielkew View Post
    Thanks for this code, should i create a module or put this code in each sheet?
    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.



    Quote Originally Posted by mielkew View Post
    I have several sheets that varies the column location of file extension and file path.
    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.



    Quote Originally Posted by mielkew View Post
    Also, how can i set the range to look into last row which is not blank?
    This can be done easily, especially if there is no data below the last row of data where you want to add hyperlinks.



    Quote Originally Posted by mielkew View Post
    Does this code will automatically add the hyperlink whenever data is added at the end of the table?
    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)).

  5. #5
    Neophyte mielkew's Avatar
    Join Date
    Feb 2018
    Posts
    4
    Articles
    0
    Excel Version
    2016
    I really appreciate you taking time to look into this, I really want this to be done in VBA instead of Formula as user tend to delete the formula.

    You can download the file I currently working on.

    https://www.dropbox.com/s/pmhpmv6b1q...CESS.xlsm?dl=0

    Thanks a lot.



    Sent from my iPhone using Tapatalk

  6. #6
    Super Moderator p45cal's Avatar
    Join Date
    Dec 2012
    Posts
    1,523
    Articles
    0
    Excel Version
    365
    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.

  7. #7
    Neophyte mielkew's Avatar
    Join Date
    Feb 2018
    Posts
    4
    Articles
    0
    Excel Version
    2016
    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

  8. #8
    Super Moderator p45cal's Avatar
    Join Date
    Dec 2012
    Posts
    1,523
    Articles
    0
    Excel Version
    365
    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

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •