Avatar of rckollar
rckollar asked on

How to Create Multiple HyperLinks in Excel Spreadsheet all-at-once

I know how to create hyper-links in Excel, on an individual basis.  Is there a way to hyper-link a large list of items in one-shot?

For audit purposes, I was asked to create a spreadsheet with a list of 300+ file names in sequential order (e.g. 057309206.TIF, 057309207.TIF, 057309208.TIF, etc.).  I would like to have the file name referenced in each cell hyper-linked to the corresponding file located in a specific folder.

Is there a way to do this with existing Excel functions, or VB Code?
Visual Basic ClassicMicrosoft ExcelVB Script

Avatar of undefined
Last Comment
Mike Wolfe

8/22/2022 - Mon
Chris Bottomley

See if this helps.

Semi automatic anyway, any questions then ask here.

Chris
Chris Bottomley

Saurabh Singh Teotia

Do you meant this....

HTH...

Saurabh...


Sub hyperlink()
Dim cell As Range, rng As Range
Set rng = Range("A1:A2000")
x = 57309206
XPath = "C:\Documents and Settings\e404244\My Documents\"
For Each cell In rng
ak = XPath & x & ".tif"
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=ak, TextToDisplay:=cell.Value
x = x + 1
Next cell
 
End Sub

Open in new window

Experts Exchange is like having an extremely knowledgeable team sitting and waiting for your call. Couldn't do my job half as well as I do without it!
James Murphy
Saurabh Singh Teotia

In Line 5th...define your own path where the document is saved....

Saurabh....
Chris Bottomley

The principle is to populate two arrays, one of source information, one of target information then the main macro kicks offgenerating the links.

The main changes would be the populate routines for both and then the links themselves i.e.

                TestReqs(reqIndex).Worksheet.Hyperlinks.Add anchor:=TestReqs(reqIndex).Offset(0, -8), Address:="", SubAddress:="'" & TestDetails(detIndex).Worksheet.Name & "'!" & TestDetails(detIndex).Offset(0, -11).Address

to something more like:

    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="filename.pdf", _
        TextToDisplay:="Something meaningful like filename"

Chris

Option Explicit
Option Base 1
Public TestReqs() As Range
Public TestDetails() As Range
Sub GenerateLinks()
Dim ws As Worksheet
Dim reqIndex As Long
Dim detIndex As Long
Dim reportDetail As String
 
    populateTestRequirements
    populateTestDetails
'    Debug.Print TestDetails(1).Address & " : " & TestDetails(1).Text
    For reqIndex = 1 To UBound(TestReqs)
        For detIndex = 1 To UBound(TestDetails)
            If TestReqs(reqIndex).Text = TestDetails(detIndex).Text Then
'                Debug.Print "Process links for test " & TestDetails(detIndex).Text
                TestReqs(reqIndex).Worksheet.Hyperlinks.Add anchor:=TestReqs(reqIndex).Offset(0, -8), Address:="", SubAddress:="'" & TestDetails(detIndex).Worksheet.Name & "'!" & TestDetails(detIndex).Offset(0, -11).Address
                TestReqs(detIndex).Worksheet.Hyperlinks.Add anchor:=TestDetails(detIndex).Offset(0, -11), Address:="", SubAddress:="'" & TestReqs(reqIndex).Worksheet.Name & "'!" & TestReqs(reqIndex).Offset(0, -8).Address
            End If
        Next
    Next
    
End Sub
 
Sub populateTestRequirements()
Dim ws As Worksheet
Dim rw As Long
 
    Err.Clear
    On Error Resume Next
    ReDim TestReqs(1)
    If Err.Number <> 0 Then ReDim TestReqs(1)
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name Like "List*" Then
            For rw = ws.Range("L1").End(xlDown).Row To ws.Range("L" & ws.Rows.Count).End(xlUp).Row
                Set TestReqs(UBound(TestReqs)) = ws.Range("L" & rw)
                ReDim Preserve TestReqs(UBound(TestReqs) + 1)
            Next
        End If
    Next
    ReDim Preserve TestReqs(UBound(TestReqs) - 1)
    
End Sub
Sub populateTestDetails()
Dim ws As Worksheet
Dim rw As Long
 
    Err.Clear
    On Error Resume Next
    ReDim TestDetails(1)
    If Err.Number <> 0 Then ReDim TestDetails(1)
    For Each ws In ThisWorkbook.Worksheets
        If Not ws.Name Like "List*" Then
            For rw = ws.Range("L1").End(xlDown).Row To ws.Range("L" & ws.Rows.Count).End(xlUp).Row
                Set TestDetails(UBound(TestDetails)) = ws.Range("L" & rw)
                ReDim Preserve TestDetails(UBound(TestDetails) + 1)
            Next
        End If
    Next
    ReDim Preserve TestDetails(UBound(TestDetails) - 1)
    
End Sub
 
Sub delHypers()
Dim hyp As Hyperlink
Dim ws As Worksheet
 
    For Each ws In ThisWorkbook.Worksheets
        For Each hyp In ws.Hyperlinks
            hyp.Delete
        Next
    Next
End Sub

Open in new window

ASKER CERTIFIED SOLUTION
Mike Wolfe

Log in or sign up to see answer
Become an EE member today7-DAY FREE TRIAL
Members can start a 7-Day Free trial then enjoy unlimited access to the platform
Sign up - Free for 7 days
or
Learn why we charge membership fees
We get it - no one likes a content blocker. Take one extra minute and find out why we block content.
See how we're fighting big data
Not exactly the question you had in mind?
Sign up for an EE membership and get your own personalized solution. With an EE membership, you can ask unlimited troubleshooting, research, or opinion questions.
ask a question