CODEWITHSUNDEEP
vbaexcelhyperlink
kf dhivya
kf dhivya

Reputation: 85

Hyperlink cell to the source Sheet

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.

Upvotes: 1

Views: 185

Answers (2)

Winterknell
Winterknell

Reputation: 585

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

Upvotes: 1

Nicolaesse
Nicolaesse

Reputation: 2714

You could use this

Sub LinkToSheet()
Dim SheetName As String

Sheets(SheetName).Select
EndSub

and then insert a button or a link to run this Sub. Of course you have to parametrize the value of "SheetName".

Upvotes: 0

Related Questions