Use VBA to hyperlink based on cell text

[NeedVBAh3lp]

I have an excel file that visually looks similar to a windows explorer view. So C203 has a folder name, and E204:E317 have the file name (next folder name is in C318). I would like to use VBA to create a hyperlink for everthing in column E (relative, but needs to reference the 'folder' listed above it in column C). I've been searching forums for a while and can't seem to get it quite right.

Here's what I have so far...

Sub CreateHyperlink()
Dim c
Dim FolderName
 
FolderName = ActiveCell.Offset(0, -2).Range("A1").Select
    Selection.End(xlUp).Select
For Each c In Selection
ActiveSheet.Hyperlinks.Add Anchor:=c, Address:= _
FolderName & c.Value, TextToDisplay:=c.Value
 
Next c
End Sub

The problem is that "foldername" actually selects the cell and starts working there, instead of the range I orignally select. Ideally it would also continue through blank values. THANKS in advance for the help.

 

[Jerry Sullivan]

lcol=14

I spotted one error. This should read...

For lCol = .Column To .Column + .Columns.Count-1

Hopefully that was the cause of the error you had.

 

[NeedVBAh3lp]

I spotted one error. This should read...

For lCol = .Column To .Column + .Columns.Count-1

Hopefully that was the cause of the error you had.

Still got the error...and not really sure how to do this

Please check this value in the Immediate Window
?rRevRange.Address

 

[Jerry Sullivan]

Still got the error...and not really sure how to do this

From inside your VB Editor enter Ctrl-G to open the Immediate Window.
When the debugger stops the code, type into the Immediate Window
?rRevRange.Address

This returns the current value of that Property into the next line in the Immediate Window.

 

[NeedVBAh3lp]

Actually I think it's working completely right! The only time it's giving an error now is if I select cells inside F, and outside F at the same time...but there is no need for them to do that anyway....Thank you soooo much. I will spend a little bit more time with it tomorrow just to make sure, but I think we (you) have got the solution nailed.

 

[Jerry Sullivan]

Actually I think it's working completely right! The only time it's giving an error now is if I select cells inside F, and outside F at the same time...but there is no need for them to do that anyway....Thank you soooo much. I will spend a little bit more time with it tomorrow just to make sure, but I think we (you) have got the solution nailed.

Well, the intent was that you could select a range that included cells in Col F and those to the Right of Column F.
I hate to have you limiting your use of this over what is probably a simple error I've overlooked.

The error would appear to be that there is no Intersection between the rRevRange and lCol.
If you make the two corrections we found, I'm not seeing how that could be the case.

Could you try inserting the line below into the "corrected" code
to see what address rRevRange has when it errors?

Sub CreateHyperlink3()
    Dim c As Range, rRevRange As Range
    Dim FolderName As String, FolderName2 As String
    Dim sFileName As String
    Dim i As Long, lCol As Long
     
    If Not Intersect(Columns("F"), Selection) Is Nothing Then
        For Each c In Intersect(Selection, Range("F1:F" & _
                 Cells(Rows.Count, "F").End(xlUp).Row))
             If c <> vbNullString Then
                 FolderName = c.Offset(0, -2).End(xlUp).Value
                 FolderName2 = c.Offset(0, -4).End(xlUp).Value
                 
                 ActiveSheet.Hyperlinks.Add Anchor:=c, _
                     Address:="..\" & FolderName2 & "\" & FolderName & "\" _
                        & c.Value, TextToDisplay:=c.Value
             End If
        Next c
    End If

    Set rRevRange = Intersect(Range(Columns("G"), Columns(Columns.Count)), _
            Selection, ActiveSheet.UsedRange)
    If rRevRange Is Nothing Then Exit Sub
    With rRevRange
        Msgbox "Address: " & .Address
        For lCol = .Column To .Column + .Columns.Count-1
            FolderName = Cells(5, lCol).Value
            If FolderName <> vbNullString Then
                For Each c In Intersect(Columns(lCol), .Cells)
                    If c <> vbNullString Then
                        sFileName = Cells(c.Row, "F").Value
                        ActiveSheet.Hyperlinks.Add Anchor:=c, _
                            Address:="..\" & FolderName & "\" _
                            & sFileName, TextToDisplay:=c.Value
                    End If
                Next c
            End If
        Next lCol
    End With
End Sub

 

[Jerry Sullivan]

I've found an unanticipated scenario - hopefully it's the cause of the error you received.

As an example, if the Selection spans Columns G:Z, the code tries to be efficient and only check each Cell in Columns that have Foldernames in G5:Z5.

If one of those cells has a Foldername, but the Selected Cells in that Column have no "x's", then an Error like the one you describe would arise.
This could happen whether or not the Selection included Cells from both Column F and the Revision Columns.

Here is revised code that should handle that scenario.

Sub CreateHyperlink4()
    Dim c As Range, rRevRange As Range
    Dim FolderName As String, FolderName2 As String
    Dim sFileName As String
    Dim i As Long, lCol As Long
     
    If Not Intersect(Columns("F"), Selection) Is Nothing Then
        For Each c In Intersect(Selection, Range("F1:F" & _
                 Cells(Rows.Count, "F").End(xlUp).Row))
             If c <> vbNullString Then
                 FolderName = c.Offset(0, -2).End(xlUp).Value
                 FolderName2 = c.Offset(0, -4).End(xlUp).Value
                 
                 ActiveSheet.Hyperlinks.Add Anchor:=c, _
                     Address:="..\" & FolderName2 & "\" & FolderName & "\" _
                        & c.Value, TextToDisplay:=c.Value
             End If
        Next c
    End If

    Set rRevRange = Intersect(Range(Columns("G"), Columns(Columns.Count)), _
            Selection, ActiveSheet.UsedRange)
    If rRevRange Is Nothing Then Exit Sub
    With rRevRange
        For lCol = .Column To .Column + .Columns.Count - 1
            FolderName = Cells(5, lCol).Value
            If FolderName <> vbNullString Then
                If Not Intersect(Columns(lCol), .Cells) Is Nothing Then
                    For Each c In Intersect(Columns(lCol), .Cells)
                        If c <> vbNullString Then
                            sFileName = Cells(c.Row, "F").Value
                            ActiveSheet.Hyperlinks.Add Anchor:=c, _
                                Address:="..\" & FolderName & "\" _
                                & sFileName, TextToDisplay:=c.Value
                        End If
                    Next c
                End If
            End If
        Next lCol
    End With
End Sub

 

[NeedVBAh3lp]

After testing your new code a little it seems like I might have found the issue. I have some cells between F and M that have dates in them that seem to be causing the error. Because I currently don't foresee linking the cells in this area I think this code will work. If you really just want to keep working on this we can...but I think it's probably going to work perfectly without the users ever encountering the error.

 

[Demianf]

Since your text strings to create the full hyperlink are found in various cells, I would be remiss if I didn't point out the HYPERLINK function (formula) that does this same thing without VBA.

If the folder is in C203 and the filename is in E204, then, in F204 you could put:

=HYPERLINK($C$203&$E204, "Open File")

Sheet1

*	B	C	D	E	F	G
*	*	*	*	*	*
*	C:\2010\	*	*	*	*
*	*	*	MyFile.xls	*
*	*	*	NextFile.xls	*
*	*	*	Another.xls	*
*	*	*	*	*	*

<tbody>
[TD="bgcolor: #cacaca, align: center"]202[/TD]

[TD="bgcolor: #cacaca, align: center"]203[/TD]

[TD="bgcolor: #cacaca, align: center"]204[/TD]

[TD="align: center"]Link[/TD]

[TD="bgcolor: #cacaca, align: center"]205[/TD]

[TD="align: center"]Link[/TD]

[TD="bgcolor: #cacaca, align: center"]206[/TD]

[TD="align: center"]Link[/TD]

[TD="bgcolor: #cacaca, align: center"]207[/TD]

</tbody>

Spreadsheet Formulas

Cell Formula F204 =HYPERLINK($C$203&$E204, "Link") <tbody> </tbody>

<tbody>
</tbody>

Excel tables to the web >> Excel Jeanie HTML 4

I've been trying to determine how I can create hyperlinks based on cell text to external websites. I have a small workbook, only a couple hundred lines, but each record will have 4-6 hyperlinks unique to that record. Each hyperlink is identical across all records, except for the identifier number.

For example, one link is C G A5

The bolded text is the unique feature, but it's not quite that easy. There may be links with static text after the bolded cell text.

What I am hoping to do is create a formula or some code (I have zero knowledge of coding) that will do the following:

I'd love to be able to input a bill number in column A, and have a formula with the basic structure for the relevant link (example above), but that inserts the text from column A into the hyperlink. The sample quoted above may work, but would require that I have the remainder of the link text elsewhere in the workbook. Ideally, I'd love to have this in the formula only.

Also, since most of the hyperlinks will have static text before and after the cell text I'm trying to use, but I'm not sure if that matters.

I know enough about Excel to know that this is feasible, and for intelligent folks with experience using Excel, probably not terribly onerous. I just don't know what the options are and every time I search, I end up with VB code, which I suspect is overkill for this effort.

[TABLE="class: grid, width: 1705"]
<tbody>[TR]
[TD="width: 64"]Bill Number[/TD]
[TD="width: 30"][/TD]
[TD="width: 380"]Title[/TD]
[TD="width: 64"]Bill[/TD]
[TD="width: 73"]Committee[/TD]
[TD="width: 68"]Hearing[/TD]
[TD="width: 48"]Support?[/TD]
[TD="width: 46"]Rec Testimony[/TD]
[TD="width: 64"]OHA Testimony[/TD]
[TD="width: 46"]Link to Testimony[/TD]
[TD="width: 42"]New Mandate?[/TD]
[TD="width: 270"]Notes[/TD]
[TD="width: 64"]Amendments[/TD]
[TD="width: 64"][/TD]
[TD="width: 54"]Position[/TD]
[TD="width: 136"]Action[/TD]
[TD="width: 64"]JF Report[/TD]
[TD="width: 64"]Fiscal Note[/TD]
[TD="width: 64"]Bill Analysis[/TD]
[/TR]
[TR]
[TD="width: 64"]5
[/TD]
[TD="width: 30"]LINK[/TD]
[TD="width: 380"]AN ACT CONCERNING HEALTH INSURANCE COVERAGE FOR TELEMEDICINE SERVICES[/TD]
[TD="width: 64"]LINK[/TD]
[TD="width: 73"]Insurance and Real Estate
[/TD]
[TD="width: 68"]2/3[/TD]
[TD="width: 48"]Yes[/TD]
[TD="width: 46"]Yes[/TD]
[TD="width: 64"][/TD]
[TD="width: 46"]LINK[/TD]
[TD="width: 42"]Maybe[/TD]
[TD="width: 270"]Mandate?[/TD]
[TD="width: 64"]LINK[/TD]
[TD="width: 64"][/TD]
[TD="width: 54"][/TD]
[TD="width: 136"][/TD]
[TD="width: 64"]LINK[/TD]
[TD="width: 64"]LINK[/TD]
[TD="width: 64"]LINK[/TD]
[/TR]
</tbody>[/TABLE]



Thanks in advance!!

 

[jbeaucaire]

If you provide a single full example I can help you construct the HYPERLINK() formula.

1) what is the exact URL you would like to create
2) What part(s) of that URL can be found in a specific cell on a specific row?

For instance, if the url were:

http://www.yahoo.com/MSF/account/12345

And MSF were in C5 and 12345 were in A5, the Hyperlink formula might be:

=HYPERLINK("http://www.yahoo.com/" & C5 & "/account/" & A5, "Link")

 

[ssjeff]

I want to thank you as your suggestion solved what I was trying to do! I have been trying to do it in VBA for a while now.