Giving Hyperlink to the excel text

[rinijg]

Hi, I am developing a code to search for a particular text in all the worksheets of a workbook named 'database' and paste the names of the worksheets in which the text is present in a worksheet named 'Find_Result' in the workbook 'search'.
Following is the code for that

Sub searchname()
    Dim DestBook As Workbook, SrcBook As Workbook
    Dim Lost As Variant
    Dim rngFound As Range, sh As Worksheet, shOutput As Worksheet
 Application.ScreenUpdating = False
Set SrcBook = ThisWorkbook
On Error Resume Next
Set DestBook = Workbooks.Open("C:\Documents and Settings\jgr\Desktop\WORKING\Database.xls")
    Set shOutput = SrcBook.Worksheets("Find_Result")
    shOutput.Range("A2:A65536").ClearContents
    Lost = InputBox(prompt:="Type in the details you are looking for!", _
                    Title:=" Find what?", Default:="*")
    
    If Lost = "" Then Exit Sub
    
    For Each sh In DestBook.Worksheets
        
       ' If Not sh.Name = shOutput.Name Then
        
            With sh.UsedRange
                
                Set rngFound = .Find(What:=Lost, LookIn:=xlValues)
                
                If Not rngFound Is Nothing Then
                      
                    shOutput.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Value = sh.Name
                
                End If
                
            End With
            
       ' End If
        
    Next
    shOutput.Activate
   DestBook.Save
DestBook.Close
 On Error GoTo 0
Set DestBook = Nothing
Set SrcBook = Nothing
End Sub

Now I have to give hyperlinks to the names of the worksheets that was pasted in Find_Result and when the name is clicked the entire worksheet with that name has to be pasted from the B column of Find_Result worksheet. But I am unable to find out how to do that? I don't know how to put hyperlink also. Can some VBA wizard help me in writing code for this?? Please

 

[AlphaFrog]

Replace this...

    shOutput.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Value = sh.Name

With something like this...

    shOutput.Hyperlinks.Add _
        Anchor:=shOutput.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0), _
        Address:=DestBook.FullName, _
        SubAddress:="'" & rngFound.Parent.Name & "'" & "!" & rngFound.Address, _
        ScreenTip:="Match found in cell: " & rngFound.Address(0, 0), _
        TextToDisplay:=sh.Name

 

[rinijg]

working absolutely fine... Thanks a lot... You made my day

 

[AlphaFrog]

You're welcome. I'm glad it works for you.

A couple of comments on your code for what it's worth.

• It's not good practice to use On Error Resume Next the way you do. How would you know if you had a problem?
• You open DestBook and then prompt the user for input. If the user cancels, you exit the procedure leaving DestBook open. You could prompt the user before opening DestBook in case they decide to cancel.
• You can both close and save DestBook with just DestBook.Close Savechanges:=True
  

 

[rinijg]

Thanks a lot for your valuable comments

 

[rinijg]

Hi, Now I am facing another problem. when the inputbox appears and if I dont type anything and i press cancel, its showing Runtime error 9, subscript out of range. How can i clear that?

 

[AlphaFrog]

Can't help without seeing what you've changed. Also, what line is highlighted?

 

[rinijg]

I got where i went wrong. It cleard now. Thanks a ton again