Hyperlink cell to the source Sheet

Question

I've below code which will create a consolidated sheet. I need a cell value to be hyperlinked that can route to the source sheet. Please find the below code.

Sub Collect()
    Dim myInSht As Worksheet
    Dim myOutSht As Worksheet
    Dim aRow As Range
    Dim aCol As Range
    Dim myInCol As Range
    Dim myOutCol As Range
    Dim calcState As Long
    Dim scrUpdateState As Long
    Dim cell As Range
    Dim iLoop As Long, jLoop As Long

    jLoop = 2

' loop through the worksheets
    For Each myInSht In ActiveWorkbook.Worksheets
' pick only the worksheets of interest
        'If myInSht.Name = "a" Or myInSht.Name = "aa" Or myInSht.Name = "aaa" Then
        ' find the columns of interest in the worksheet
            For Each aCol In myInSht.UsedRange.Columns
                Set myOutCol = Nothing
                If aCol.Cells(1, 1).Value = "timestamp" Then Set myOutCol = Sheets("Summary").Range("B2:B1000")
                If aCol.Cells(1, 1).Value = "ip" Then Set myOutCol = Sheets("Summary").Range("C2:C1000")
                If aCol.Cells(1, 1).Value = "protocol" Then Set myOutCol = Sheets("Summary").Range("D2:D1000")
                If aCol.Cells(1, 1).Value = "port" Then Set myOutCol = Sheets("Summary").Range("E2:E1000")
                If aCol.Cells(1, 1).Value = "hostname" Then Set myOutCol = Sheets("Summary").Range("F2:F1000")
                If aCol.Cells(1, 1).Value = "tag" Then Set myOutCol = Sheets("Summary").Range("G2:G1000")
                If aCol.Cells(1, 1).Value = "asn" Then Set myOutCol = Sheets("Summary").Range("I2:I1000")
                If aCol.Cells(1, 1).Value = "geo" Then Set myOutCol = Sheets("Summary").Range("J2:J1000")
                If aCol.Cells(1, 1).Value = "region" Then Set myOutCol = Sheets("Summary").Range("K2:K1000")
                If aCol.Cells(1, 1).Value = "naics" Then Set myOutCol = Sheets("Summary").Range("L2:L1000")
                If aCol.Cells(1, 1).Value = "sic" Then Set myOutCol = Sheets("Summary").Range("M2:M1000")
                If aCol.Cells(1, 1).Value = "server_name" Then Set myOutCol = Sheets("Summary").Range("H2:H1000")

                If Not myOutCol Is Nothing Then
' don't move the top line, it contains the headers - no data
                    Set myInCol = aCol
                    Set myInCol = myInCol.Offset(1, 0).Resize(myInCol.Rows.Count, myInCol.Columns.Count)
' transfer data from the project tab to the consolidated tab
                    iLoop = jLoop
                    For Each aRow In myInCol.Rows
                        myOutCol.Cells(iLoop, 1).Value = aRow.Cells(1, 1).Value
                        iLoop = iLoop + 1
                    Next aRow
                End If
            Next aCol
            'End If
        If iLoop > jLoop Then jLoop = iLoop
    Next myInSht
    End Sub

I would like to create a hyperlink cells on column tag. so i click it should take me to the source sheet from the summary sheet.

Your Summary sheet stitches together data from, potentially, multiple sheets. The Summary has only one header row. Which sheet do you want linked? (I once attached individual hyperlinks to every cell in a large sheet. Once was enough.) Attaching a hyperlink to the top cell in each block of data is probably feasible. — Winterknell

Winterknell Winterknell · Accepted Answer · 2017-03-14T09:53:35

I'm rusty with hyperlinks so this is a bit clunky looking, but the code below should point you in the right direction.

If Not MyOutCol Is Nothing Then
    ' don't move the top line, it contains the headers - no data
    Set MyInCol = aCol
    Set MyInCol = MyInCol.Offset(1, 0).Resize(MyInCol.Rows.Count, MyInCol.Columns.Count)
    ' transfer data from the project tab to the consolidated tab
    iLoop = jLoop
    For Each aRow In MyInCol.Rows
        MyOutCol.Cells(iLoop, 1).Value = aRow.Cells(1, 1).Value
        iLoop = iLoop + 1
    Next aRow

    MyOutCol.Parent.Hyperlinks.Add _
        Anchor:=MyOutCol.Cells(jLoop, 1), _
        Address:="", _
        SubAddress:=MyInCol.Parent.Name & "!" & MyInCol.Address, _
        TextToDisplay:=MyInCol.Cells(1, 1).Value

End If

Edits: replaced aCol with MyIncol, changed 1 to jLoop, moved hyperlink code to after range has been populated

Hyperlink cell to the source Sheet

2 Answers