VBA finding a cell based on the value of a pivot table

paeddi

New Member
Joined
Aug 17, 2019
Messages
7
Hi together,

I would like to jump (eventually with VBA) from a cell in a pivot table to find the cell with that value in the original table.
I imagine that the current value has to be copied to the clipboard and that the value has to be searched (CTRL+F) in the source table.

How does the solution looks likes?

Thanks in advance for your response.

Patrick
 

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.
The following is assuming the source on the same sheet where you have the pivot table.


Change "pivot1" to the name of your pivottable.


Select a cell in your pivottable and run the macro.


Code:
Sub finding_cell()
    Dim td As PivotTable, sh As Worksheet, addr As String
    Dim f As Range
    
    Set sh = ActiveSheet
    Set td = sh.PivotTables("pivot1")
    addr = td.SourceData
    addr = Mid(addr, InStr(1, addr, "!") + 1)
    addr = Replace(addr, "F", "R")
    addr = Application.ConvertFormula(Formula:=addr, fromreferencestyle:=xlR1C1, toreferencestyle:=xlA1)
    
    Set f = Range(aCell).Find(ActiveCell.Value, , xlValues, xlWhole)
    If Not f Is Nothing Then
      f.Select
    End If
End Sub
 
Upvote 0
Thank you for the quick response. The pivottable is unfortunately in a different worksheet.
I tried to shift the pivottable into the source table to see if the code would work. here it stops at "
Set f = Range(aCell).Find(ActiveCell.Value, , xlValues, xlWhole)

returning the error message 1004

If possible I would prefer to have it jumped to the original table located in another worksheet.
 
Upvote 0
Try this

Change "Sheet5" by the name of another sheet

Code:
Sub finding_cell()
    Dim td As PivotTable, sh As Worksheet, addr As String
    Dim f As Range, sh1 As Worksheet, wItem As String
    
    Set sh = ActiveSheet
    Set sh1 = Sheets("[COLOR=#ff0000]Sheet5[/COLOR]")
    Set td = sh.PivotTables("pivot1")
    
    wItem = ActiveCell.Value
    addr = td.SourceData
    addr = Mid(addr, InStr(1, addr, "!") + 1)
    addr = Replace(addr, "F", "R")
    addr = Application.ConvertFormula(Formula:=addr, fromreferencestyle:=xlR1C1, toreferencestyle:=xlA1)
    
    sh1.Select
    Set f = Range(addr).Find(wItem, , xlValues, xlWhole)
    If Not f Is Nothing Then
      f.Select
    End If
End Sub
 
Upvote 0
Hi

the Makro stops here:
Set f = Range(addr).Find(wItem, , xlValues, xlWhole)

It jumps to the original worksheet, but does not find the value selected in the pivot-table in the other sheet.

and still brings the error message: run time error '1004'

And the error message translated into English: "The method 'range' for the object '_Global' has failed.



Kind regards

Patrick
 
Upvote 0
So I don't understand how you have your data, on which sheet you have the table, or where to look.
You have to be more specific about how you have your information, otherwise I'm just guessing.

You could upload a copy of your file to a free site such www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. If the workbook contains confidential information, you could replace it with generic data.
 
Upvote 0
Hi thank you for your advise.
I have uploaded an extract of my Excel-file on GMX Cloud.

https://c.gmx.net/@326733481163888445/2fUlCD9CRHm6WZAUvo55Kg

the passwort for access the file is
hellohello


I have depicted two usecases.
Jumping from worksheet "Pivot" cell C10 (marked in blue) to worksheet "Mastertabelle Einzel" cell B4

OR
Jumping from worksheet "Pivot" cell C5 (marked in yellow) to worksheet "Mastertabelle Einzel" cell B8

The goal is to select a cell in the pivottabelle and execute the script, so that it jumps to the cell in the original table with the identical content.

kind regards

Patrick
 
Upvote 0
Try this

Code:
Sub finding_cell()
    Dim td As PivotTable, sh As Worksheet, addr As String
    Dim f As Range, sh1 As Worksheet, wItem As String
    
    Set sh = ActiveSheet
    Set sh1 = Sheets("Mastertabelle Einzel")
    Set td = sh.PivotTables("PivotTable1")
    
    wItem = ActiveCell.Value
    If wItem = "" Then Exit Sub
    addr = td.SourceData
    addr = Mid(addr, InStr(1, addr, "!") + 1)
    addr = Replace(addr, "F", "R")
    addr = Application.ConvertFormula(Formula:=addr, fromreferencestyle:=xlR1C1, toreferencestyle:=xlA1)
    
    sh1.Select
    Set f = Range(addr).Find(wItem, , xlValues, xlWhole)
    If Not f Is Nothing Then
      f.Select
    End If
End Sub
 
Upvote 0
Thank you, unfortunately I still get exactly the same error message as mentioned above

run time error '1004'

And the error message translated into English: "The method 'range' for the object '_Global' has failed.

and the script still stops at

Set f = Range(addr).Find(wItem, , xlValues, xlWhole)
 
Upvote 0
Thank you, unfortunately I still get exactly the same error message as mentioned above
run time error '1004'
And the error message translated into English: "The method 'range' for the object '_Global' has failed.
and the script still stops at
Set f = Range(addr).Find(wItem, , xlValues, xlWhole)


I tried it with your file and it works. In which language do you have excel?


Try this, a message window should appear.
Tell me what the message says.

Code:
Sub finding_cell()
    Dim td As PivotTable, sh As Worksheet, addr As String
    Dim f As Range, sh1 As Worksheet, wItem As String
    
    Set sh = ActiveSheet
    Set sh1 = Sheets("Mastertabelle Einzel")
    Set td = sh.PivotTables("PivotTable1")
    
    wItem = ActiveCell.Value
    If wItem = "" Then Exit Sub
    addr = td.SourceData

msgbox "address = " & addr


    addr = Mid(addr, InStr(1, addr, "!") + 1)
    addr = Replace(addr, "F", "R")
    addr = Application.ConvertFormula(Formula:=addr, fromreferencestyle:=xlR1C1, toreferencestyle:=xlA1)
    
    sh1.Select
    Set f = Range(addr).Find(wItem, , xlValues, xlWhole)
    If Not f Is Nothing Then
      f.Select
    End If
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,484
Messages
6,113,920
Members
448,533
Latest member
thietbibeboiwasaco

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top