VBA Code for Search & activate a Worksheet Cell with a Hyperlink in it

[Randy11]

Have a workbook name Test.
On Sheet1 Cells B2:B50 have hyperlinks in them to other locations within the workbook. The Hyperlink cells have formulas such as:
=HYPERLINK("#"&"Sheet4!$Z$5",Sheet4!$Z$2)
Z2 on Sheet4 will have Text or a number. This is an example of a value that is searched for in the range B2:B5 on Sheet1. Z2 in this Case is Delaware, another is California, another is 92506

In a nut shell.
Use input box to search Sheet 1 Range B2:B50, if value is located in range activate the hyperlink in that cell to navigate to the location desired.

Code works to the last line, Activate.Hyperlink. Hyperlink does not activate. Not sure I have this stated correctly.

This is what I have so far:

Sub Search_Navigate()
'
' Search_Navigate Macro
'

'
Dim strFind As String
Dim rFound As Range
Dim lReply As Long


Sheets("Sheet1").Select
Columns("B:B").Select

strFind = InputBox("Find Location or Location Code?", "FIND IT")
If strFind = vbNullString Then Exit Sub

With ActiveSheet
If WorksheetFunction.CountIf(.UsedRange, strFind) = 0 Then
MsgBox strFind & " cannot be found on this sheet"
Else
Set rFound = .UsedRange.Find(strFind, .Cells(1, 1), xlValues, xlWhole, , , False)

lReply = MsgBox(strFind & " is in cell " & rFound.Address & " Click ok To Navigate", vbOKCancel + vbQuestion)
If lReply = vbOK Then Application.Goto rFound, True
rFound.Activate
Activate.Hyperlink


End If
End With
End Sub

 

[SkipVought]

hi,

[b]
   dim hl as hyperlink[/b]
'......
            lReply = MsgBox(strFind & " is in cell " & rFound.Address & "  Click ok To Navigate", vbOKCancel + vbQuestion)
[b]
            If lReply = vbOK Then
                For Each hl In ActiveSheet.Hyperlinks
                    If hl.Range.Address = rFound.Address Then
                        hl.Follow
                        Exit For
                    End If
                Next
            End If[/b]

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[Randy11]

Still not working. Code finds the cell with the hyperlink but will not follow it.
Had to add End If & End With, prior to end sub.. in order to allow code to run



Sub Search_Navigate()
'
' Search_Navigate Macro
'

'
Dim strFind As String
Dim rFound As Range
Dim lReply As Long
Dim hl As Hyperlink

Sheets("Sheet1").Select
Columns("B:B").Select

strFind = InputBox("Find Location or Location Code.", "FIND IT")
If strFind = vbNullString Then Exit Sub

With ActiveSheet
If WorksheetFunction.CountIf(.UsedRange, strFind) = 0 Then
MsgBox strFind & " cannot be found on this sheet"
Else
Set rFound = .UsedRange.Find(strFind, .Cells(1, 1), xlValues, xlWhole, , , False)

lReply = MsgBox(strFind & " is in cell " & rFound.Address & " Click ok To Navigate", vbOKCancel + vbQuestion)

If lReply = vbOK Then
For Each hl In ActiveSheet.Hyperlinks
If hl.Range.Address = rFound.Address Then
hl.Follow
Exit For
End If
Next
End If
End If
End With


End Sub

 

[Randy11]

Issue with this Code still outstanding. Code locates excel hyperlink in cell but will not activate the Hyperlink to go to the end destiantion. Ideas appreciated......

 

[SkipVought]

Set rFound = [b]Selection[/b].Find(strFind, [b]Selection[/b].Cells(1, 1), xlValues, xlWhole, , , False)

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[SkipVought]

BTW, you should have provided the statement that your code errored on and the error message, rather than "Still not working". SOP!

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[Randy11]

Hi Skip & Co. Unfortunately, am not receiving an error, just does not navigate via the link in the cell. Replaced the line you have provided above & still not working.
Input box opens, takes search value. Message box opens & tell me which cell the searched value is in click ok & it should navigate via the link to the sheet in question. Code completes with Column B selectet.
Ideas???

 

[SkipVought]

Have you STEPPED thru your code?

What happens?

I can run your code and it works!!!

Sub Search_Navigate()
'
' Search_Navigate Macro
'

'
   Dim strFind As String
    Dim rFound As Range
    Dim lReply As Long
    Dim hl As Hyperlink
     
    Sheets("Sheet1").Select
    Columns("B:B").Select
    
    strFind = InputBox("Find Location or Location Code.", "FIND IT")
    If strFind = vbNullString Then Exit Sub
    
With ActiveSheet
        If WorksheetFunction.CountIf(.UsedRange, strFind) = 0 Then
            MsgBox strFind & " cannot be found on this sheet"
        Else
            Set rFound = Selection.Find(strFind, Selection.Cells(1, 1), xlValues, xlWhole, , , False)
             
            lReply = MsgBox(strFind & " is in cell " & rFound.Address & "  Click ok To Navigate", vbOKCancel + vbQuestion)

            If lReply = vbOK Then
                For Each hl In ActiveSheet.Hyperlinks
                    If hl.Range.Address = rFound.Address Then
                        hl.Follow
                        Exit For
                    End If
                Next
            End If
End If
End With


End Sub

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}