Гиперссылка на основе значения другой ячейки

Question

Я травил форумы в поисках решения.

У меня есть код для создания гиперссылки, основанный на значении столбца B. Он работает, но только в том случае, если я запускаю sub при выборе ячейки.

Что мне нужно для гиперссылкой, чтобы автоматически добавляется, если ячейка в значение столбца H является «ОК»

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 

Любая помощь будет принята с благодарностью.

Answer 1

Изменить

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

Для

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

И

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

Для

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

Answer 2

Нравится?

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