CODEWITHSUNDEEP
excelvba
James Hurst
James Hurst

Reputation: 63

Hyperlink Cell based on Value of another cell

I Have trawled the forums looking for a solution.

I have a code for creating a hyperlink based on the column B cell value. It works but only if the I run the sub whilst selecting the cell.

What I need is for the hyperlink to get automatically added if the cell in column H's value is "ok" 

Sub Hyperlinks()

Dim r As Range
Dim FilePath As String

If Intersect(Columns("B"), Selection) Is Nothing Then Exit Sub

For Each r In Intersect(Selection, Range("B2:B" & _
Cells(Rows.Count, "B").End(xlUp).Row))
If r <> vbNullString Then

FilePath = "T:\BLUEMAC\Search Paths\PDF MASTER FOLDER\"

ActiveSheet.Hyperlinks.Add Anchor:=r, _
Address:=FilePath & r.Value & ".pdf", TextToDisplay:=r.Value
End If
Next r

End Sub

Any help would be greatly appreciated.

Upvotes: 1

Views: 419

Answers (2)

Jochen
Jochen

Reputation: 1254

Change

If Intersect(Columns("B"), Selection) Is Nothing Then Exit Sub

For Each r In Intersect(Selection, Range("B2:B" & _
Cells(Rows.Count, "B").End(xlUp).Row))

To

For Each r In Range("B2:B" & Cells(Rows.Count, "B").End(xlUp).Row)

And

ActiveSheet.Hyperlinks.Add Anchor:=r, _
Address:=FilePath & r.Value & ".pdf", TextToDisplay:=r.Value

To

If r.offset(0,6).value = "ok" then ActiveSheet.Hyperlinks.Add Anchor:=r, _
Address:=FilePath & r.Value & ".pdf", TextToDisplay:=r.Value

Upvotes: 1

SierraOscar
SierraOscar

Reputation: 17647

Like this?

Sub Hyperlinks()

Dim r As Range
Dim FilePath As String

If Intersect(Columns("B"), Selection) Is Nothing Then Exit Sub

For Each r In Intersect(Selection, Range("B2:B" & Cells(Rows.Count, "B").End(xlUp).Row))
    If r <> vbNullString And LCase$(r.Offset(0, 6).value) = "ok" Then
        FilePath = "T:\BLUEMAC\Search Paths\PDF MASTER FOLDER\"
        ActiveSheet.Hyperlinks.Add Anchor:=r, _
             Address:=FilePath & r.Value & ".pdf", TextToDisplay:=r.Value
    End If
Next r

End Sub

Upvotes: 0

Related Questions