Adding hyperlinks to names with vba

Question

My VBA skills are nonexistent, and I have not been able to find any threads that fit my situation, hence this thread.

I have a column in an Excel sheet containing names (column B) and I'm trying to hyperlink the cells in B to web pages. There's one specific web page for each row.

It'd be easy to just use the HYPERLINK function if I have a column with all of the corresponding URLS but the problem is that the final version of the spreadsheet will not have a column with URLs.

What the final version will include: (column B) names hyperlinked to specific web pages, and (column A) IDs that includes a unique part of the URL plus the name from B

The URLs are all identical except for the number at the end. The part that doesn't change is:

http://www.regulations.gov/#!documentDetail;D=CFPB-2011-0008

and there's a four-digit number at the end for each URL.

The bit starting with "CFPB" and ending with the four-digit number is the part that's going to be included in column A.

So my plan is to write a VBA program that adds hyperlinks to B using URLs constructed from

http://www.regulations.gov/#!documentDetail;D=

and the front part of the corresponding cells in A (e.g. CFPB-2011-0008-0002). I'm thinking of using the LEFT function to get this second part of the URL from A (e.g. LEFT(A1,19)).

Sorry if the explanation is not clear... Any help will be much appreciated.

Answer 1

I understand the question correctly, you can do this with a simple worksheet function. Just concatenate the URL together:

=HYPERLINK(CONCATENATE("http://www.regulations.gov/#!documentDetail;D=",LEFT(A1,14)))

One VBA solution to just add URLs to the existing document names would be something like:

Sub AddHyperlinks()

    Dim url As String

    Dim current As Range
    For Each current In Selection.Cells
        url = "http://www.regulations.gov/#!documentDetail;D=" & _
              Left$(current.Value, 14)
        current.Worksheet.Hyperlinks.Add current, url
    Next current

End Sub

Select the cells you want to add hyperlinks to and run the macro.

Answer 2

I put a script together the other day to do something similar, you'll want to put it into a loop or something to go through your list in the spreadsheet. I use iCurrentRow and iCurrentCol to navigate round my sheet.

Use the functions you suggested to build the hyperlink string in the cell you want it in i.e. the cells in Column B, and then set the strString to this value. I've added strString in just now (has not been tested), so if it doesn't work then you may need to encompass it inside CStr().

It should give you something to work from anyway.

' Set the string to the hyperlink address    
strString = Cells(iCurrentRow, iCurrentCol).value
' Check if the cell already has a hyperlink
If Cells(iCurrentRow, iCurrentCol).Hyperlinks.Count > 0 Then
    'If it does then check if it is the same as in the cell
     If strString  <> CStr(Cells(iCurrentRow, iCurrentCol).Hyperlinks(1).Address) Then
         'Check if there is no new hyperlink
          If strString = "" Then
              Cells(iCurrentRow, iCurrentCol).Hyperlinks.Delete
          Else
              ActiveSheet.Hyperlinks.Add Anchor:=Cells(iCurrentRow, iCurrentCol), _
                  Address:=strString
          End If
      End If
Else
    'If there isn't an existing hyperlink then add it
     If strString <> "" Then
         ActiveSheet.Hyperlinks.Add Anchor:=Cells(iCurrentRow, iCurrentCol), _
             Address:=strString 
     End If
End If

Answer 3

Give this a try:

Sub MAIN()
    Dim rng As Range, rr As Range, r As Range
    Set rng = Intersect(Range("B:B"), ActiveSheet.UsedRange)

    For Each rr In rng
        If rr.Value <> "" Then
            Set r = rr
            Call hyper_maker(r)
        End If
    Next rr
End Sub

Sub hyper_maker(r As Range)
    If r.Hyperlinks.Count > 0 Then
        r.Hyperlinks.Delete
    End If
    txt = r.Value
    s = "http://www.regulations.gov/#!documentDetail;D=" & txt
    r.Value = s
    r.Select
    Application.SendKeys "{F2}"
    Application.SendKeys "{ENTER}"
    DoEvents
    r.Hyperlinks(1).TextToDisplay = txt
End Sub