none
create hyperlink address automatically for selected cells using Excel VBA RRS feed

  • Question

  • Dear Experts: 


    I wonder wheter an EXCEL macro can perform the following actions: 

    For the selected cell, e.g. B5 with the cell value 90-038-58-10 (the format in the selected cell is always
    ##-###-##-##)
    , insert a hyperlink with the following hyperlink address: 
    \\172.20.10.68\daten$\KLS_Allgemein\DMD\PM_2_3\IFU_IPS_Implants_Unterarmrekonstruktion_90-038-58-10_REV_1_RD_2018-11_5s_A6_S116_bw.pdf, 

    -  the path name (bolded part) always stays the same no matter which cell value is selected
    - the macro is to search for the number (formatted italic, 90-038-58-10) in the above folder (PM2_3)  and if the unique number is found in some file name, the macro is to take that file name and create the full hyperlink address. 

    - the macro should work on any selected cell 
    I hope I could make myself clear. 

    Help is highly appreciated. Thank you very much in advance. 

    Regards, Andreas

    Wednesday, May 22, 2019 7:03 AM

Answers

  • Try this version:

    Sub InsertHyperlinks()
        Const p = "\\172.20.10.68\daten$\KLS_Allgemein\DMD\PM_2_3\"
        Dim c As Range
        Dim s As String
        Selection.Hyperlinks.Delete
        For Each c In Selection
            s = Dir(p & "*" & c.Value & "*.pdf")
            If s <> "" Then
                ActiveSheet.Hyperlinks.Add Anchor:=c, Address:=p & s, TextToDisplay:=c.Value
            End If
        Next c
    End Sub


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    • Marked as answer by Iamgrateful Thursday, May 23, 2019 6:46 AM
    Wednesday, May 22, 2019 12:21 PM

All replies

  • Try this:

    Sub InsertHyperlinks()
        Dim c As Range
        Dim s As String
        Selection.Hyperlinks.Delete
        For Each c In Selection
            s = "\\172.20.10.68\daten$\KLS_Allgemein\DMD\PM_2_3\*" & c.Value & "*.pdf"
            If Dir(s) <> "" Then
                ActiveSheet.Hyperlinks.Add Anchor:=c, Address:=s, TextToDisplay:=c.Value
            End If
        Next c
    End Sub


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Wednesday, May 22, 2019 10:18 AM
  • Hi Hans, 

    thank you very much for your quick reply. I really appreciate this. I guess I could not make myself clear, It is quite a complicated requirement. 

    Running your code produces the following result based on the example I provided.

    \\172.20.10.68\daten$\KLS_Allgemein\DMD\PM_2_3\*90-038-58-10*.pdf

    As a matter of fact it should look like this

    \\172.20.10.68\daten$\KLS_Allgemein\DMD\PM_2_3\IFU_IPS_Implants_Unterarmrekonstruktion_90-038-58-10_REV_1_RD_2018-11_5s_A6_S116_bw.pdf

    That is, the number (90-038-58-10 in this case) is always just a substring in a much bigger filename in that given directory. The macro is to search for this number in all of the pdfs in that given directory and if found retrieve the whole filename. 

    Hope this is feasible and does not entail too much complicated coding. 

    Help is very much appreciated. Thank you very much in advance. 

    Regards, Andreas





    • Edited by Iamgrateful Wednesday, May 22, 2019 12:15 PM
    Wednesday, May 22, 2019 11:49 AM
  • What should happen if there are multiple PDF files whose name contains 90-038-58-10?

    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Wednesday, May 22, 2019 12:18 PM
  • Try this version:

    Sub InsertHyperlinks()
        Const p = "\\172.20.10.68\daten$\KLS_Allgemein\DMD\PM_2_3\"
        Dim c As Range
        Dim s As String
        Selection.Hyperlinks.Delete
        For Each c In Selection
            s = Dir(p & "*" & c.Value & "*.pdf")
            If s <> "" Then
                ActiveSheet.Hyperlinks.Add Anchor:=c, Address:=p & s, TextToDisplay:=c.Value
            End If
        Next c
    End Sub


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    • Marked as answer by Iamgrateful Thursday, May 23, 2019 6:46 AM
    Wednesday, May 22, 2019 12:21 PM
  • Wow, Hans I am deeply impressed. Seems to work just fine. Will do some more testing and then let you know. 

    Again, Thanks a lot,

    Andreas

    Wednesday, May 22, 2019 12:28 PM
  • Again, Hans, thank you very much for your great help. Works like a charm, this will save me hours and hours of tedious work. 

    THANK YOU

    Andreas

    Thursday, May 23, 2019 6:47 AM