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

[paeddi]

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

 

[DanteAmor]

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.

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

 

[paeddi]

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.

 

[DanteAmor]

Try this

Change "Sheet5" by the name of another sheet

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

 

[paeddi]

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

 

[DanteAmor]

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.

 

[paeddi]

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

 

[DanteAmor]

Try this

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

 

[paeddi]

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)

 

[DanteAmor]

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.

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