Follow hyperlinks in a pivot table
Basically, when I do a refresh of the data in the "pivotdata" worksheet, I need it to recognise the cell is a hyperlink. In addition, when I update the indivital pivot tables, it looks at the data in the "Notes" field and recognise it as a hyperlink.
Answer:
Here is a simple pivottable, in sheet1.
Vba code
- Copy vba code below
- Press Alt + F11
- Double click your sheet in project explorer
- Paste into code window
- Return to Microsoft Excel
Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim ptc As PivotTable, Value As Variant, Rng As Range
If Target.Cells.Count = 1 Then
For Each ptc In ActiveSheet.PivotTables
If Not Intersect(Target, Range(ptc.TableRange1.Address)) Is Nothing Then
If Left(Target.Value, 7) = "http://" Then
ActiveWorkbook.FollowHyperlink Address:=Target.Value, NewWindow:=True
End If
End If
Next ptc
End If
End Sub
Now try clicking a cell containing a hyperlink in the pivot table!
Download excel 2007 workbook *.xlsm
Hyperlinks in pivot tables.xlsm
Related posts:
Excel vba: Populate a combobox with values from a pivot table
Disable autofit column widths for all pivot tables in a sheet
Quickly create links to sheets, tables, pivot tables and named ranges in a workbook
Recommended categories
Oscar,
That seems to work a treat. because I have 3 pivot tables on individual worksheets that are not the same worksheet as the pivot data, I have placed the code on each of the pivot table sheets. I'm assuming this is correct, as it didn't work on the other pivot table sheets where I hadn't included the code.
Any chance to could add comments to the code, so that I can work out what the subroutine is doing ?
The help is appreciated and hopefully it will help others as well.
Kind Regards
Sean
Sean,
Thanks!
I have added comments to the code.
This code works for all pivotTables in a workbook.
Copy/paste the code below to "ThisWorkbook" code module in project explorer (Alt+F11)
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) Dim ptc As PivotTable, Value As Variant, Rng As Range For Each ptc In Worksheets(Sh.Name).PivotTables If Not Intersect(Target, Range(ptc.TableRange1.Address)) Is Nothing Then If Left(Target.Value, 7) = "http://" Then ActiveWorkbook.FollowHyperlink Address:=Target.Value, NewWindow:=True End If End If Next ptc End SubDownload excel *.xlsm file
Hyperlinks-in-pivot-tables-in-a-workbook.xlsm
The follow code from above works well except that the first time I click on a hyperlink, I get a Run Time Error 13. When I reset and click again, it's fine. What could be the cause of this. Code is below:
Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim ptc As PivotTable
'Find every pivotTable in ActiveSheet
For Each ptc In ActiveSheet.PivotTables
'Check if selected cell is a pivot table cell
If Not Intersect(Target, Range(ptc.TableRange1.Address)) Is Nothing Then
'Check if the cell value begins wih http://
If Left(Target.Value, 7) = "http://" Then
'Follow hyperlink using cell value as hyperlink address
ActiveWorkbook.FollowHyperlink Address:=Target.Value, NewWindow:=True
End If
End If
Next ptc
End Sub
Brian,
Run Time Error 13 - Type mismatch
Which line is the problem?
Hey Brian,
I get the same Error 13, when I select a range of cells.
Following Line is (according to Excel) the problem:
If Left(Target.Value, 7) = "http://" Then
Best,
Christian
Sorry, Oscar of course
Christian,
You are right. If you select more than one cell you get an error.
Try this:
Sub Worksheet_SelectionChange(ByVal Target As Range) Dim ptc As PivotTable, Value As Variant, Rng As Range If Target.Cells.Count = 1 Then For Each ptc In ActiveSheet.PivotTables If Not Intersect(Target, Range(ptc.TableRange1.Address)) Is Nothing Then If Left(Target.Value, 7) = "http://" Then ActiveWorkbook.FollowHyperlink Address:=Target.Value, NewWindow:=True End If End If Next ptc End If End SubThanks for commenting!
The Attachement has no Excel files
Code is not working with xl 2007
deepak ji paulson,
I downloaded both files and they work here. I am using excel 2007.
Oscar, you are awesome! millions of thanks
HI,
THe link is working fine but if i need to click on the Text or value column and if the hyperlink has to be opened what could be the solution for that?.
Harshitha,
Sub Worksheet_SelectionChange(ByVal Target As Range) Dim ptc As PivotTable, Value As Variant, Rng As Range For Each ptc In ActiveSheet.PivotTables If Not Intersect(Target, Range(ptc.TableRange1.Address)) Is Nothing Then If Left(ptc.TableRange1.Cells(Target.Row - ptc.TableRange1.Row + 1, 1).Value, 7) = "http://" Then ActiveWorkbook.FollowHyperlink Address:=ptc.TableRange1.Cells(Target.Row - ptc.TableRange1.Row + 1, 1).Value, NewWindow:=True End If End If Next ptc End SubYou probably need to change this line:
If Left(ptc.TableRange1.Cells(Target.Row - ptc.TableRange1.Row + 1, 1).Value, 7) = "http://" Then
Bolded value is the column number for the links in the Pivot table range.
[...] Use a VBA solution, as described here: Follow hyperlinks in a pivot table | Get Digital Help - Microsoft Excel resource [...]