1 Attachment(s)
[RESOLVED] Showdetail of Pivot table values based on criteria
I want to show detail of the values based on criteria appearing in my pivot table in a separate worksheets. Below is what I have so far, which shows the details for all items.
Code:
Sub MakeReports()
Dim c As Range
With ActiveSheet.PivotTables(1)
For Each c In .DataBodyRange.Resize(, 1)
c.ShowDetail = True
Next c
End With
End Sub
below is pivot snapshot, I want macro to refer to the last 2 columns (.i.e. Column D and E) and if the values in both columns match then macro should show the details of both the values in one worksheet (or in separate worksheet is also fine) and where it doesn't match it should not show details and loop through the cells of both the columns till the pivot end. Excel version used by me is excel 2010.
Re: Showdetail of Pivot table values based on criteria
Re: Showdetail of Pivot table values based on criteria
Select the range for the pivot table.
copy it
create a new sheet
paste special values
-- loop the values and remove rows if columns are not equal
--- or add a new column and put in a function to check they are equal, copy and paste to the end, auto filter the top to false, remove rows, remove filter
1 Attachment(s)
Re: Showdetail of Pivot table values based on criteria
Quote:
Originally Posted by
westconn1
post a sample workbook
Attached is the sample made up data file. I want matching records underlying data into separate worksheets, that's the reason i want to use pivot's show detail function to loop through the pivot columns and showdetail .i.e. underlying data in separate worksheet , where else ecniv's solution only talks about the matching values to be filtered in the pivot.
Re: Showdetail of Pivot table values based on criteria
Quote:
Originally Posted by
abhay_547
I want matching records underlying data into separate worksheets, that's the reason i want to use pivot's show detail function to loop through the pivot columns and showdetail .i.e. underlying data in separate worksheet
Um.. double click the row? Should be default action on the pivot table, whether you use code or not to generate it.
And what you asked for was the two values matching in the columns from the pivot table. Its a little more complicated to grab the actual data rows. You'd need a field at the start of the row, for each row with matching values, then find the data in the data sheet and copy to a new output sheet.
1 Attachment(s)
Re: Showdetail of Pivot table values based on criteria
Ok. Since the pivot table would have multiple such matching rows, scrolling through it and clicking on each of it, is not viable option, hence i want macro to do it for me. I can apply formula to compare between 2 columns and get the TRUE or FALSE in the adjacent column.
Macro should look through each row in column G and if the value in it is "TRUE" then it should offset 1 column to left and select the respective row cell in Column F and execute the showdetail function of pivot to show underlying data of Column F in a separate sheet and do the same .i.e. loop till the end of pivot executing same action. Something like below, but the problem is that once it goes to the newly created show detail sheet how to switch it back to the pivot sheet and loop again.
Code:
Sub ShowPivotdataDetails()
Dim N As Long, i As Long, j As Long
N = Cells(Rows.Count, "A").End(xlUp).Row
j = 5
For i = 5 To N
If Cells(i, "G").Value = "TRUE" Then
Cells(i, "G").Offset(0, -1).Select
Selection.ShowDetail = True '
' this above line takes the code to newly created sheet where the show detail appear, how to switch back to pivot sheet.
j = j + 1
End If
Next i
End Sub
Re: Showdetail of Pivot table values based on criteria
can someone help with the above code.
Re: Showdetail of Pivot table values based on criteria
Code:
Dim r As Range
For rw = 5 To 12
Set r = Cells(rw, 4)
With r
If .Value = .Offset(, 1) Then
.Offset(, 2).ShowDetail = True
End If
End With
Next
this code worked in your sample workbook, 3 additional sheets were created
it would be better practice to specify the worksheet containing the cells
Code:
Set r = ws.Cells(rw, 4)
where ws is a worksheet object
Re: Showdetail of Pivot table values based on criteria
Ok. This works. I have made a minor tweak for the row count. another thing, is it possible to move showdetail data of each matching item into one worksheet with the same macro, instead of separate worksheets or we have to use a separate combine macro to combine all showdetail worksheets data into one, post running the below macro.
Code:
Sub ShowPivotDetailsmacro()
Dim r As Range
Dim ws As Worksheet
Set ws = ThisWorkbook.ActiveSheet
RowCount = WorksheetFunction.Count(Range("F:F"))
For rw = 5 To RowCount
Set r = ws.Cells(rw, 4)
With r
If .Value = .Offset(, 1) Then
.Offset(, 2).ShowDetail = True
End If
End With
Next
End Sub
Re: Showdetail of Pivot table values based on criteria
Quote:
is it possible to move showdetail data of each matching item into one worksheet
i do not believe so
Quote:
or we have to use a separate combine macro
i would believe it would be quite possible to combine the worksheets within the same macro, i will think about it
Re: Showdetail of Pivot table values based on criteria
Ok. I have tried below with combine sheets but it gets stuck on the line which is highlighted in Blue and Bold. shows "runtime error '1004' the operation cannot be completed for one of the following reasons:
• A selection including cells both inside a table and below it cannot be copied and inserted into that table. Select cells outside the table and try inserting the data again. • You have attempted to fill data in the way not supported by the table"
Code:
Sub ShowPivotDetailsmacro()
Dim r As Range
Dim ws As Worksheet
Set ws = ThisWorkbook.ActiveSheet
RowCount = WorksheetFunction.Count(Range("F:F"))
For rw = 5 To RowCount
Set r = ws.Cells(rw, 4)
With r
If .Value = .Offset(, 1) Then
.Offset(, 2).ShowDetail = True
End If
End With
Next
Dim i As Integer
Dim xTCount As Variant
Dim xWs As Worksheet
xTCount = 1
Set xWs = ActiveWorkbook.Worksheets.Add(Sheets(1))
xWs.Name = "DetailData"
Sheets("Sheet2").Range("A1").EntireRow.Copy Destination:=xWs.Range("A1")
For i = 2 To Worksheets.Count
For Each xWs In ThisWorkbook.Worksheets
If xWs.Name <> "Pivot" And xWs.Name <> "Pivot2" And xWs.Name <> "Mapping" Then
Worksheets(i).Range("A1").CurrentRegion.Offset(CInt(xTCount), 0).Copy _
Destination:=xWs.Cells(xWs.UsedRange.Cells(xWs.UsedRange.Count).row + 1, 1)
End If
Next
Next
Application.DisplayAlerts = False
Application.DisplayAlerts = False
For Each ws In ThisWorkbook.Worksheets
Select Case ws.Name
Case "Pivot", "Pivot2", "Mapping", "DetailData" ' add as required
' do nothing
Case Else
ws.Delete
End Select
Next
Application.DisplayAlerts = TrueApplication.DisplayAlerts = True
End Sub
Re: Showdetail of Pivot table values based on criteria
Code:
Dim r As Range, s As Worksheet
Set s = Sheets("Pivot")
cnt = Sheets.Count
For rw = 5 To 12
Set r = s.Cells(rw, 4)
With r
If .Value = .Offset(, 1) Then
.Offset(, 2).ShowDetail = True
If Sheets.Count = cnt + 1 Then
Sheets(1).Name = "newsheet"
Else
Sheets(2).UsedRange.Copy Sheets("newsheet").Cells(Rows.Count, 1).End(xlUp).Offset(2)
Application.DisplayAlerts = False
Sheets(2).Delete
Application.DisplayAlerts = True
End If
End If
End With
Next
I tested with this seems to work OK
Re: Showdetail of Pivot table values based on criteria
Thanks a lot. It works as expected :)
Code:
Sub ShowPivotDetailsmacro()
Application.DisplayAlerts = False
Dim r As Range, s As Worksheet
Set s = Sheets("Pivot")
cnt = Sheets.Count
For rw = 5 To WorksheetFunction.Count(Range("F:F"))
Set r = s.Cells(rw, 4)
With r
If .Value = .Offset(, 1) Then
.Offset(, 2).ShowDetail = True
If Sheets.Count = cnt + 1 Then
Sheets(1).Name = "newsheet"
Else
Sheets(2).UsedRange.Copy Sheets("newsheet").Cells(Rows.Count, 1).End(xlUp).Offset(1)
Application.DisplayAlerts = False
Sheets(2).Delete
Application.DisplayAlerts = True
End If
End If
End With
Next
Application.DisplayAlerts = True
End Sub
1 Attachment(s)
Re: [RESOLVED] Showdetail of Pivot table values based on criteria
On more thing, though, Is it possible to add a last column in the end after copying the data to newsheet, with the text "Match 1", "Match 2" and so on, as shown in the below snapshot.
Also can we paste special values while pasting the tables into newsheet and ignore headers as well by offsetting rows while copying (except for first dup set), or we have to copy the data from the newsheet and paste it into another sheet to do the same and remove the header like below.
Code:
Sheets("newsheet").Select
Cells.Select
Selection.Copy
Sheets.Add
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Re: [RESOLVED] Showdetail of Pivot table values based on criteria
try this one
Code:
Dim r As Range, s As Worksheet
Set s = Sheets("Pivot")
cnt = Sheets.Count
For rw = 5 To 12
Set r = s.Cells(rw, 4)
With r
If .Value = .Offset(, 1) Then
.Offset(, 2).ShowDetail = True
If Sheets.Count = cnt + 1 Then
With Sheets(1)
scnt = Mid(.Name, 6)
Sheets(1).Name = "newsheet"
.Cells(2, Columns.Count).End(xlToLeft).Offset(, 1).Resize(.Cells(Rows.Count, 1).End(xlUp).Row - 1).Value = "Match" & scnt
End With
Else
With Sheets(2)
scnt = Mid(.Name, 6)
lcol = .Cells(2, Columns.Count).End(xlToLeft).Column
lrow = .Cells(Rows.Count, 1).End(xlUp).Row
.Cells(2, 1).Offset(, lcol).Resize(lrow - 1).Value = "Match" & scnt
.Cells(2, 1).Resize(lrow - 1, lcol + 1).Copy Sheets("newsheet").Cells(Rows.Count, 1).End(xlUp).Offset(1)
End With
' Sheets(2).UsedRange.Copy Sheets("newsheet").Cells(Rows.Count, 1).End(xlUp).Offset(2)
Application.DisplayAlerts = False
Sheets(2).Delete
Application.DisplayAlerts = True
End If
End If
End With
Next
Re: [RESOLVED] Showdetail of Pivot table values based on criteria
This works great. Only issue is that in the last column it starts as Match2, Match3, Match4 and so on. so basically even when it finds the first match and pastes it in the newsheet, it will tag it in the last column as Match2 and follow the sequence.
Re: [RESOLVED] Showdetail of Pivot table values based on criteria
there was some reason why i decided that it would be a good idea to use the newly created sheet number for the match number, but i do not now remember what it was
change like
Code:
.Offset(, 2).ShowDetail = True
scnt = scnt +1
remove the other 2 lines starting scnt =
also, it occurred to me, while the code works in the sample workbook, if the pivot sheet is not the first worksheet, some other changes would be required for sheet indexing or some sheets might be deleted in error, besides getting the wrong data
Re: [RESOLVED] Showdetail of Pivot table values based on criteria
Now it shows Runtime error '1004' you cannot part of a pivot table report. or insert worksheet cells, rows, columns inside a pivot table report....
highlighted error line in blue...
Code:
Dim r As Range, s As Worksheet
Set s = Sheets("Pivot")
cnt = Sheets.Count
For rw = 5 To 12
Set r = s.Cells(rw, 4)
With r
If .Value = .Offset(, 1) Then
.Offset(, 2).ShowDetail = True
If scnt = cnt + 1 Then
With Sheets(1)
' scnt = Mid(.Name, 6)
Sheets(1).Name = "newsheet"
.Cells(2, Columns.Count).End(xlToLeft).Offset(, 1).Resize(.Cells(Rows.Count, 1).End(xlUp).Row - 1).Value = "Match" & scnt
End With
Else
With Sheets(2)
' scnt = Mid(.Name, 6)
lcol = .Cells(2, Columns.Count).End(xlToLeft).Column
lrow = .Cells(Rows.Count, 1).End(xlUp).Row
.Cells(2, 1).Offset(, lcol).Resize(lrow - 1).Value = "Match" & scnt
.Cells(2, 1).Resize(lrow - 1, lcol + 1).Copy Sheets("newsheet").Cells(Rows.Count, 1).End(xlUp).Offset(1)
End With
' Sheets(2).UsedRange.Copy Sheets("newsheet").Cells(Rows.Count, 1).End(xlUp).Offset(2)
Application.DisplayAlerts = False
Sheets(2).Delete
Application.DisplayAlerts = True
End If
End If
End With
Next
Regarding the sheet order issue, I noticed that while testing so I was keeping the pivot sheet as the first sheet in the workbook to avoid error.
Re: [RESOLVED] Showdetail of Pivot table values based on criteria
this is tested and appears to work correctly
Code:
Dim r As Range, s As Worksheet
Set s = Sheets("Pivot")
cnt = Sheets.Count
For rw = 5 To 12
Set r = s.Cells(rw, 4)
With r
If .Value = .Offset(, 1) Then
.Offset(, 2).ShowDetail = True
scnt = scnt + 1
If Sheets.Count = cnt + 1 Then
With Sheets(1)
' scnt = Mid(.Name, 6)
Sheets(1).Name = "newsheet"
.Cells(2, Columns.Count).End(xlToLeft).Offset(, 1).Resize(.Cells(Rows.Count, 1).End(xlUp).Row - 1).Value = "Match" & scnt
End With
Else
With Sheets(2)
lcol = .Cells(2, Columns.Count).End(xlToLeft).Column
lrow = .Cells(Rows.Count, 1).End(xlUp).Row
.Cells(2, 1).Offset(, lcol).Resize(lrow - 1).Value = "Match" & scnt
.Cells(2, 1).Resize(lrow - 1, lcol + 1).Copy Sheets("newsheet").Cells(Rows.Count, 1).End(xlUp).Offset(1)
End With
Application.DisplayAlerts = False
Sheets(2).Delete
Application.DisplayAlerts = True
End If
End If
End With
Next
the code for this only works in later versions of excel, so i can not test or update on my usual computer and have to wait for when i can use the later versions
