Excel VBA Hyperlinks Function Between Sheets not activating cell

I am working on an excel workbook with two sheets. In column C of the first sheet (Sheet1!C1:C500) I have a string in each cell. I wrote up the following code to find where that string occurs in column B of sheet 2 (Sheet2!B1:B184) and convert the cell in Sheet 1 to a hyperlink to its corresponding cell in Sheet 2.

Sub HypLinks()

    Dim NametoFind As String

    Sheets("Sheet1").Activate

    For Each c In Range(Range("C1"),_
    Range("C1").End(xlDown).End(xlDown).End(xlUp))
        NametoFind = c.Value
        Worksheets("Sheet2").Activate
        Set gg = Range(Range("B1"),_ 
       Range("B1").End(xlDown).End(xlDown).End(xlUp)).Find(NametoFind,_ 
        LookIn:=xlValues)
        Worksheets("Sheet1").Activate
        ActiveSheet.Hyperlinks.Add Range("Sheet1!C" & c.Row),_ 
        Address:="", SubAddress:="#Sheet2!" & gg.Address,_
        TextToDisplay:=c.Value
    Next

End Sub

Everything works fine except for the fact that when I click the hyperlink it only takes me to Sheet2 but does not activate the cell specified by gg.Address. If I remove the "#Sheet2!" the cell specified by gg.Address is activated but in Sheet 1 not sheet 2.

1 answer

  • answered 2018-04-17 04:49 Siddharth Rout

    Your problem can be solved by changing

    Set gg = Range(Range("B1"), _
    Range("B1").End(xlDown).End(xlDown).End(xlUp)).Find(NametoFind, _
    LookIn:=xlValues)
    

    to

    Set gg = Worksheets("Sheet2").Range(Worksheets("Sheet2").Range("B1"), _
    Worksheets("Sheet2").Range("B1").End(xlDown).End(xlDown).End(xlUp)).Find(NametoFind, _
    LookIn:=xlValues)
    

    That is becuase you have not fully qualified your cells.

    Having said that, it is a very complicated and unreliable way of doing it. I would recommend, declaring objects, variables and then work with them. Also use error handling. For example if there is no match found then gg.Address will give you an error :)

    Edit

    See this example. Here you do not need to even activate the worksheets

    Sub HypLinks()
        Dim wsA As Worksheet, wsB As Worksheet
        Dim NametoFind As String
        Dim lRow As Long
        Dim gg As Range, aCell As Range
        Dim rngA As Range, rngB As Range
    
        '~~> Set your worksheets
        Set wsA = Sheets("Sheet1")
        Set wsB = Sheets("Sheet2")
    
        '~~> Sheet2
        With wsB
            '~~> Find last row in Col B
            lRow = .Range("B" & .Rows.Count).End(xlUp).row
            '~~> Set you range
            Set rngB = .Range("B1:B" & lRow)
        End With
    
        '~~> Sheet1
        With wsA
            '~~> Find last row in Col C
            lRow = .Range("C" & .Rows.Count).End(xlUp).row
            '~~> Set you range
            Set rngA = .Range("C1:C" & lRow)
    
            '~~> looping through the range
            For Each aCell In rngA
                NametoFind = aCell.Value
    
                Set gg = rngB.Find(NametoFind, LookIn:=xlValues)
    
                '~~> If find returns a match
                If Not gg Is Nothing Then
                    wsB.Hyperlinks.Add wsA.Range("Sheet1!C" & aCell.row), _
                    Address:="", SubAddress:="#Sheet2!" & gg.Address, _
                    TextToDisplay:=aCell.Value
                End If
            Next aCell
        End With
    End Sub