PDA

View Full Version : Solved: Filtering Pivot Items by value



marshybid
05-14-2008, 06:23 AM
Hi All,

I have the following line in my Pivot Table creation



ActiveSheet.PivotTables("PivotTable1").PivotFields("Order ID").PivotItems _("(blank)").Visible = False


This just removed balnk items from the final pivot table (very useful)

However I would like to be able to only show items for a another PivotField("PercUsed") that are <50?? I first thought that I could just do the following



ActiveSheet.PivotTables("PivotTable1").PivotFields("PercUsed").PivotItems _("(<50)").Visible = False


But that doesn't work...:dunno

Can anyone help.

Thanks

Marshybid

Bob Phillips
05-14-2008, 08:00 AM
That doesn't work because you hide a particular pt value. The first works because there are ( maybe) blank values, but there are no values that are <51, they may be 10, 20 and so on, but that is not a value of <51.

What you need to do is create a calculated field that tests if <50 and hide by that field.

marshybid
05-14-2008, 08:17 AM
Thanks xld,

I guess that as I don't actually want the data that is <50 anyway, I should probably just add to my original data sort code and remove row where - if mybaseRow.Cells.Item(1, #) <50 Then
mybaseRow.Delete

Then create the pivot table, only the required data will be included.

Based on the above option, how would I change the code to paste the unwanted data into a new worksheet rather than mybaseRow.Delete?? That way I would always have the original raw data as a backup if needed. The code I have iterates through each row step -1, I can't work out how to get the code to copy the rows where Item(1, #) < 50 and then paste them to a new row ina new worksheet. Whenever I try, only the last row remains in the new worksheet as each time it pastes it overwrites the last row (Doh!!!)

Marshybid

Bob Phillips
05-14-2008, 08:37 AM
Something like this



Option Explicit

Public Sub ProcessData()
Const TEST_COLUMN As String = "A" '<=== change to suit
Dim i As Long
Dim LastRow As Long
Dim NextRow As Long

With Application

.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

NextRow = Worksheets("Sheet2").Range("A1").End(xlDown).Row
If NextRow = Worksheets("Sheet2").Rows.Count Then

NextRow = 1
Else

NextRow = NextRow + 1
End If

With ActiveSheet

LastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
For i = LastRow To 1 Step -1

If .Cells(i, TEST_COLUMN).Value <> "" Then

If .Cells(i, TEST_COLUMN).Value < 50 Then

.Rows(i).Copy Worksheets("Sheet2").Cells(NextRow, "A")
.Rows(i).Delete
NextRow = NextRow + 1
End If
End If
Next i

End With

With Application

.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With

End Sub

marshybid
05-14-2008, 08:39 AM
Thanks for that, I'll give it a go today.

I will mark this thread as solved.

Marshybid :bow: