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]

Hi and Welcome to the Board,

You can try the code example below.
Typically, it's best to minimize the use of ActiveCell, Activate, Select, and Selection in VBA, and instead reference the Cells directly without Selecting each one.

The use of Selection in the code below is an exception to that guideline, because it's being used to refer to the range the User has Selected.

Sub CreateHyperlink2()
    Dim c As Range
    Dim FolderName As String
     
    If Intersect(Columns("E"), Selection) Is Nothing Then Exit Sub
   
    For Each c In Intersect(Selection, Range("E1:E" & _
            Cells(Rows.Count, "E").End(xlUp).Row))
        If c <> vbNullString Then
            FolderName = c.Offset(0, -2).End(xlUp).Value
            ActiveSheet.Hyperlinks.Add Anchor:=c, _
                Address:=FolderName & c.Value, TextToDisplay:=c.Value
        End If
    Next c
End Sub

 

[NeedVBAh3lp]

Thank You SOOO Much for this. After I posted my original question the requirement actually got changed, but I think I was able to slightly modify it and get it to work. Yeah, I completely agree about the selecting cells thing, but I couldn't figure out the ".value" thing for some reason (got sadly close). As you'll see below I had to add one extra folder, and some text characters to get the relative reference.

I do have one more thing I could use help with on this same page. This is a drawing log that tracks every time a new sheet is issued (column F - was E -are the sheet names). Each time a revision is made an "x" will be placed in a column to the right of F. Example: Each sheet (column F) changed in Rev 2 will get an "x" in column M. I would like to place a hyperlink on the "x" (and still display the x) but use the column header (static at M5) for the folders and the name of the file will still be from column F. I think I can now get the folders right for this, but I don't exactly know how the Intersect function works so I'm not sure how to deal with the column changing each time or how to make sure for each 'c' I grab the right name from column F.

Sub CreateHyperlink2()
    Dim c As Range
    Dim FolderName As String
    Dim FolderName2 As String
    'Dim FolderName3 As String
    
     
    If Intersect(Columns("F"), Selection) Is Nothing Then Exit Sub
   
    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).Value2
            
            ActiveSheet.Hyperlinks.Add Anchor:=c, _
                Address:="..\" & FolderName2 & "\" & FolderName & "\" & c.Value, TextToDisplay:=c.Value
        End If
    Next c
End Sub

 

[jbeaucaire]

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")

Excel Workbook
	B	C	D	E	F	G
202
203		C:\2010\
204				MyFile.xls	Link
205				NextFile.xls	Link
206				Another.xls	Link
207
Sheet1

 

[NeedVBAh3lp]

jbeaucaire,

Thanks for the advice. That would be a good solution except for 2 issues (which I failed to explain in my post).

1.) This same sheet will be used for a lot of different projects, by people who are even less familiar with excel than myself so I need to make it as dynamic as possible (C203 will probably never be the folder location of another project), and if we add a sheet to this project that will change as well. I know if they insert correctly it wouldn't break the link, but I don't have that much faith.

2.) Not ever sheet will be revised in each changes (your column F below). I want the user to be able to just be able to note that drawing is affected by that revision, select the column and hit my button to add the links.

Again, I really appreciate the time to put that together. But unless I'm being a little short sided I'm thinking it wouldn't quite fit my (users') needs.

 

[Jerry Sullivan]

I do have one more thing I could use help with on this same page. This is a drawing log that tracks every time a new sheet is issued (column F - was E -are the sheet names). Each time a revision is made an "x" will be placed in a column to the right of F. Example: Each sheet (column F) changed in Rev 2 will get an "x" in column M. I would like to place a hyperlink on the "x" (and still display the x) but use the column header (static at M5) for the folders and the name of the file will still be from column F. I think I can now get the folders right for this, but I don't exactly know how the Intersect function works so I'm not sure how to deal with the column changing each time or how to make sure for each 'c' I grab the right name from column F.

If I'm understanding you correctly, this code should do that.

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("F"), Columns(Columns.Count)), _
            Selection, ActiveSheet.UsedRange)
    If rRevRange Is Nothing Then Exit Sub
    With rRevRange
        For lCol = .Column To .Column + .Columns.Count
            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

 

[NeedVBAh3lp]

This is SUPER close. There are 2 problems.

1. When I select a cell in column F now it is trying to use cell F5 as the folder heading instead of the offset items you set. It's like it's skipping over that first section of code for some reason.

2. When I select a cell in other columns it works fine, but for some reason throw a runtime error 424 on the line

For Each c In Intersect(Columns(lCol), .Cells)

Here is the whole code that I just pasted in in case it helps.

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("F"), Columns(Columns.Count)), _
            Selection, ActiveSheet.UsedRange)
    If rRevRange Is Nothing Then Exit Sub
    With rRevRange
        For lCol = .Column To .Column + .Columns.Count
            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]

This is SUPER close. There are 2 problems.

1. When I select a cell in column F now it is trying to use cell F5 as the folder heading instead of the offset items you set. It's like it's skipping over that first section of code for some reason.

My mistake, this should read G instead of F

     Set rRevRange = Intersect(Range(Columns("[COLOR="Blue"][B]G[/B][/COLOR]"), Columns(Columns.Count)), _
            Selection, ActiveSheet.UsedRange)

2. When I select a cell in other columns it works fine, but for some reason throw a runtime error 424 on the line

For Each c In Intersect(Columns(lCol), .Cells)

What is the value of lCol when this errors?
You can place your cursor over lCol in the VB Editor or
Type: ?lCol in the Immediate Window of the VBE

 

[NeedVBAh3lp]

What is the value of lCol when this errors?

lcol=14

 

[Jerry Sullivan]

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