Thread: Automatic hyperlink generator with VBA

Originally Posted by snb

I don't think so:

 
Private Sub Worksheet_Change(ByVal Target As Range)
 If Target.Cells.Count > 1 Or Target.Column <> 1 Then Exit Sub

 On Error Resume Next
 Target.Hyperlinks.Delete
 Hyperlinks.Add Target, "", "'Data Sheet 2'!" & sheets("Data Sheet 2").Columns(5).Find(Target.Value, , xlValues, xlWhole).Address(,,,true)
End Sub

Thanks. I'm not sure how to handle this line from the other block of code--I get an error when using the quotation marks (assuming it sees them as the end of the statement rather than declaration of the data sheet):

If Not f Is Nothing Then Sheets("Data Sheet 4").Hyperlinks.Add c, "", "Sheets("Data Sheet 4")!" & f.Address

Thanks for everyone's help, I finally got it working. Here is the final code I am using:

Sub HyperlinkSheet4ColAToSheet2ColF()
  Dim c As Range, f As Range
  Application.EnableEvents = False
  Sheets("Data Sheet 4").Range("A2", Sheets("Data Sheet 4").Range("A" & Rows.Count).End(xlUp)).Hyperlinks.Delete
  For Each c In Sheets("Data Sheet 4").Range("A2", Sheets("Data Sheet 4").Range("A" & Rows.Count).End(xlUp))
    Set f = Sheets("Data Sheet 2").Range("F2", Sheets("Data Sheet 2").Range("F" & Rows.Count).End(xlUp)).Find(c.Value)
    If Not f Is Nothing Then Sheets("Data Sheet 4").Hyperlinks.Add c, "", "'Data Sheet 2'!" & f.Address
  Next c
  Application.EnableEvents = True
End Sub

and

Private Sub Worksheet_Change(ByVal Target As Range)
 If Target.Cells.Count > 1 Or Target.Column <> 1 Then Exit Sub

 On Error Resume Next
 Target.Hyperlinks.Delete
 Hyperlinks.Add Target, "", "'Data Sheet 2'!" & Sheets("Data Sheet 2").Columns(5).Find(Target.Value, , xlValues, xlWhole).Address(, , , True)
End Sub

Thanks again!