Add PivotItems into Values box as Averages based on criteria

[MarkCBB]

Hi there Pivot Table VBA Pros,

Looks like my questions are becoming more challenging (I hope)

I would like to add Pivot Fields to the value box of a pivot table based on the criteria on the Item on another database.

My Master based base has Product infomation (The headings on the database are the product names (eg. Blue cheese 125g), in my second database I have listed all the products by product category (eg Cheese).

I would like to add each Pivot field that is listed as cheese to the Pivot table.

My second database is set up, with products in Sheet4.range("D:D") and the Product category in Sheet4.range("B:B.

So if the data in Column B = "Cheese", i want the Item listed in Column D to be added to the pivot table.

the Pivot table is located in Sheet7 and its Pivot table 3

The Keyword (Product category is located in sheet7.range("A1")

The format of each item must be Currency.

 

[MarkCBB]

Hi there,

I have made some progress since yesturday. However I am now trying to remove all items from the Values field in the PivotTable before the next Catogory is added.

Here is the code that I have created thus far.

Sub FilterPTDataFieldsFromLookUpTable()
Dim LookUpItemCount As Integer
Dim FieldToAdd As String

LookUpItemCount = WorksheetFunction.CountA(Sheet1.Range("A:A"))

For Each cell In Sheet1.Range("B2:B" & LookUpItemCount)
    If cell.Offset(0, -1).Value = "Cheese" Then
        On Error Resume Next
            FieldToAdd = cell.Value
            With Sheet2.PivotTables("PivotTable2").PivotFields(FieldToAdd)
                .Orientation = xlDataField
                .Position = 1
                .Caption = FieldToAdd & " "
                .Function = xlAverage
                .NumberFormat = "R # ##0.00"
            End With
    End If
        On Error GoTo 0
Next cell
End Sub