Hyperlink in Pivot Table

[Nivviv]

I have a Master data sheet with 7 columns. Coulmn 3 (Ref No) and Column 7 (Vo No.) are links to different pdf files saved in a server. When I create the Pivot table the hyperlinks are lost and only the link title remains.

I found this code and it is working fine. But the issue is I need to give the entire filepath (which is very long) for this to work. I want to use a short title for the hyperlinks.

*** use code -tags ***

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count <> 1 Then Exit Sub
On Error Resume Next
Application.ActiveWorkbook.FollowHyperlink Address:=CStr(Target.Value), NewWindow:=True
End Sub

Could someone help with a VBA code to hyperlink these coulmns in the pivot table

 

[GraH - Guido]

Hi, did you use the search of the forum? This has been asked and answered before.

How to create clickable hyperlinks in pivot table?

Hi Excel professionals, I am working on a Pivot Table and need to keep the hyperlinks from the original data active and working. the hyperlinked data stored by one of the shared folder device. anyone can help me on this with the exact VBA code to working on it. and appropriate way to apply the...

chandoo.org

(references when simply using google)

Excel Hyperlinks and Hyperlink Function Step-by-Step Guide

Quick trick for Excel hyperlinks, easy HYPERLINK function examples. Hyperlink table of contents, or remove all hyperlinks. Excel hyperlink security warning

www.contextures.com

Hyperlinking in Pivot Tables | Decisive Data

www.decisivedata.net

 

[Nivviv]

Yes. I searched and I tried to use the code provided in the answer. But it was working only for the first hyperlink. the remaining was being pointed the Master Data sheet.

 

[Nivviv]

I managed to get the code from the above mentioned links. Thank You so much. I need to modify this code , Right now when I click on any pivot table cells (not the hyperlinked ones) it takes you to the Master Data sheet. How can I disable this function.

Please find the code below

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim ptc As PivotTable
Dim tradeName As String, haddress As String, tString As String
Dim c As Range, x As Double
Dim sWs As Worksheet, aWs As Worksheet

'Adjust Worksheet name as needed
Set aWs = ThisWorkbook.Worksheets("Dashboard")
Set sWs = ThisWorkbook.Worksheets("Master Data")

For Each ptc In ActiveSheet.PivotTables
    'Adjust for PivotTable header Row# as needed
    If Target.Row <= 3 Then Exit Sub
    If Target.Count > 1 Then Exit Sub
    'If Target.Value = "(blank)" Or Target.Value = "" Then
        'MsgBox "Blank cell, no hyperlink"
        'Exit Sub
    'End If
    If Not Intersect(Target, Range(ptc.TableRange1.Address)) Is Nothing Then
        tradeName = Cells(Target.Row, 1).Value
        With sWs.Cells
            Set c = .Find(tradeName, After:=Cells(2), LookIn:=xlValues, LookAt:=xlWhole)
            If Not c Is Nothing Then
                Application.ScreenUpdating = False
                
                On Error GoTo ErrHandle:
                sWs.Select
                If IsNumeric(Target.Value) Then
                    tString = Target.Value
                Else
                    tString = Chr(34) & Target.Value & Chr(34)
                End If
                
                'Adjust source data column range as needed
                With sWs.Range("A" & c.Row & ":W" & c.Row)
                    x = Application.Evaluate("Match(" & tString & "," & .Address & ",0)")
                    haddress = .Columns(x).Hyperlinks.Item(1).Address
                End With
                aWs.Select
                Application.ScreenUpdating = True
                ThisWorkbook.FollowHyperlink Address:=haddress, NewWindow:=True
                Exit Sub
            End If
        End With
    End If
Next ptc


ErrHandle:
For Each ptc In ActiveSheet.PivotTables
    If Not Intersect(Target, Range(ptc.TableRange1.Address)) Is Nothing Then
        aWs.Select
        Application.ScreenUpdating = True
        MsgBox "Error" & Err.Number & ": Unable to follow HyperLink or HyperLink address not found"
        Exit Sub
    End If
Next ptc
End Sub