How do i create multiple hyperlinks to various pdf files?

Michael

I'm a little confused as you seem to have hyperlinks in column A already.

If you did want to create hyperlinks from the content of a cell you could use the HYPERLINK worksheet function.

Yes I have done those by hand and the list has about 200 more I was hoping for a faster solution

Well HYPERLINK should be pretty fast.

All you would need to do is put it in and copy down.

Or if you really want code use the BeforDoubleClick event and FollowHyperlink.

The HYPERLINK function creates a link for whatever document you supply the URL for

Where would the URL for each document come from?

Michael

I think I know what you want to do.

What I don't know how you are arriving at the URLs for the documents.

To use any method, VBA or formula, to create hyperlinks URLs would be needed.

I looked at the URLS and I thought there was some sort of pattern but it wasn't consistent, different 'sections' used a different pattern.

For example the hyperlinks in the first 3 sections seem to follow this pattern,

\\arkansaselectric.com\FileShares\UserShares\MLittleton\Bailey Pipe Hangers\BAILEY PIPE HANGER DETAILS\<section name> (Hx)\1.pdf

but then in the BF Attemptorator and Boiler Feed Discharge sections you get this sort of thing.

\\arkansaselectric.com\FileShares\UserShares\MLittleton\Bailey Pipe Hangers\BAILEY PIPE HANGER DETAILS\<section name> (Hx-n - Hx-m)\1.pdf

Getting the actual filename is straightforward, it's the rest of the URL that's the problem.

So would it just be the section name followed by the filename?

Michael

I've been looking at this and I've come up with this which is very much a work in progress.

Sub GetURLs()
Dim rng As Range
Dim strBaseURL As String
Dim strSection As String
Dim strFileName As String
Dim I As Long

    strBaseURL = "\\arkansaselectric.com\FileShares\UserShares\MLittleton\Bailey Pipe Hangers\BAILEY PIPE HANGER DETAILS\"

    With Worksheets("Hot Reheat MS")

        For I = 5 To .Range("A" & Rows.Count).End(xlUp).Row

            If .Range("A" & I).MergeArea.Address = .Range("A" & I).Address Then
                If .Range("A" & I).Value <> "" Then
                    strFileName = Split(.Range("A" & I).Value, "-")(1) & ".pdf"
                    .Range("B" & I).Value = strSection & "\" & strFileName
                End If
            Else
                If .Range("A" & I).Interior.ColorIndex <> -4142 Then
                    strSection = Trim(Replace(.Range("A" & I).MergeArea.Cells(1, 1).Value, "Piping System", ""))
                End If
            End If

        Next I
    End With

End Sub

It seems to be producing the correct URLs for most sections but there's a problem with the sections in rows 85 to 283 where the header is followed by IsoX.

When that's the case the folder to find the file in is IsoX rather than the section header.

PS I know the code doesn't create hyperlinks, I wanted to make sure of getting the correct URLs before adding a whole bunch of invalid hyperlinks.

Once that's done the code to add the hyperlinks is pretty straightforward.

Actually just realised how it should be possible to ignore the IsoX.

Here's the updated code.

Option Explicit

Sub GetURL()
Dim rng As Range
Dim strBaseURL As String
Dim strSection As String
Dim strFileName As String
Dim I As Long

    strBaseURL = "\\arkansaselectric.com\FileShares\UserShares\MLittleton\Bailey Pipe Hangers\BAILEY PIPE HANGER DETAILS\"

    With Worksheets("Hot Reheat MS")

        For I = 5 To .Range("A" & Rows.Count).End(xlUp).Row

            If .Range("A" & I).MergeArea.Address = .Range("A" & I).Address Then
                If .Range("A" & I).Value <> "" Then
                    strFileName = Split(.Range("A" & I).Value, "-")(1) & ".pdf"
                    .Range("B" & I).Value = strSection & "\" & strFileName
                End If
            Else
                If .Range("A" & I).Interior.ColorIndex <> -4142 Then
                    If Not .Range("A" & I).Value Like "Iso*" Then
                        strSection = Trim(Replace(.Range("A" & I).MergeArea.Cells(1, 1).Value, "Piping System", ""))
                    End If
                End If
            End If

        Next I
    End With

End Sub

Good.

All we need now is the code to add the hyperlinks.

Bit rusty with that, and obviously can't test, but give this a shot.

Option Explicit



Sub GetURLs()
Dim rng As Range
Dim lnk As Hyperlink
Dim strBaseURL As String
Dim strSection As String
Dim strFileName As String

Dim I As Long

    strBaseURL = "\\arkansaselectric.com\FileShares\UserShares\MLittleton\Bailey Pipe Hangers\BAILEY PIPE HANGER DETAILS\"

    With Worksheets("Hot Reheat MS")

        For I = 5 To .Range("A" & Rows.Count).End(xlUp).Row
            Set rng = .Range("A" & I)

            If rng.MergeArea.Address = rng.Address Then
                If rng.Value <> "" Then
                    strFileName = Split(rng.Value, "-")(1) & ".pdf"

                    ' add hyperlink
                    Set lnk = rng.Hyperlinks.Add(rng, strBaseURL & strSection & "\" & strFileName)

                    ' .Range("B" & I).Value = strSection & "\" & strFileName
                End If
            Else
                If rng.Interior.ColorIndex <> -4142 Then
                    If Not rng.Value Like "Iso*" Then
                        strSection = Trim(Replace(rng.MergeArea.Cells(1, 1).Value, "Piping System", ""))
                    End If
                End If
            End If

        Next I
    End With

End Sub