Programming a PivotTable in Access VBA

Question

Let me start off by putting things in context first. I have three questions and was hoping to recieve some help on a problem I've encountered. I am developing an application where risk assessments are carried out on substances used in specific workplace/activity combinations. What I wanted to do was create a matrix report as follows:

[Workplace Name] (as a column heading)

[Activity Name] (as a row heading)

[Risk Assessment Score] (as the data)

All of these values can be retrieved via a query. I tried using a crosstab query but it seems they can only be used for summary data. I was woundering If my assumption is correct, since that is what I concluded after looking on the microsoft website. However, since I am no seasoned Acces programmer I could be wrong.

Based on my assumption I figured a PivotTable was the way to go. I found an example on http://msdn.microsoft.com/en-us/library/aa662945(office.11).aspx that I tried to replicate. The reason for programming one is so that a PivotTable can be generated based on the users criteria in a form.

The code below is a slight variation on the sample code given in the aforementioned link.

Private Sub cmdPivotTable_Click()

Dim strDefaultName As String
Dim strRecordSource As String

'Create an empty form with a PivotTable
'default view and a record source
strRecordSource = "SELECT *" _
& " FROM ((OEL RIGHT JOIN Substance ON OEL.OEL_ID = Substance.OEL_ID) INNER JOIN" _
& " ((Product INNER JOIN Proportions ON (Product.Product_Name = Proportions.Product_Name) AND (Product.Product_ID = Proportions.Product_ID) AND (Product.Product_Name = Proportions.Product_Name) AND (Product.Product_ID = Proportions.Product_ID)) INNER JOIN (STM_Workplace INNER JOIN (Respiratory_PPE INNER JOIN (STM_LocalControls INNER JOIN (STM_Diffuse INNER JOIN ((STM_Vent_NF_FF INNER JOIN Workplace ON (STM_Vent_NF_FF.STM_Vent_FF_ID = Workplace.STM_Vent_NF_ID) AND (STM_Vent_NF_FF.STM_Vent_FF_ID = Workplace.STM_Vent_NF_ID) AND (STM_Vent_NF_FF.STM_Vent_FF_ID = Workplace.STM_Vent_FF_ID)) INNER JOIN (STM_Activity_Score INNER JOIN (Activity INNER JOIN (PBMCode INNER JOIN Product_Activity ON PBMCode.ID_PBMCode = Product_Activity.ID_PBMCode) " _
& " ON Activity.Activity_ID = Product_Activity.ID_Activity) ON STM_Activity_Score.STM_ActivityScore_ID = Activity.STM_ActivityScore_ID) ON (Workplace.Workplace_ID = Product_Activity.Workplace_ID) AND (Workplace.Workplace_ID = Product_Activity.Workplace_ID)) ON STM_Diffuse.STM_Diffuse_ID = Workplace.STM_Diffuse_ID) ON STM_LocalControls.STM_LocalControls_ID = Workplace.STM_LocalControls_ID) ON (Respiratory_PPE.STM_PPE_ID = PBMCode.STM_PPE_ID) AND (Respiratory_PPE.STM_PPE_ID = PBMCode.STM_PPE_ID)) ON STM_Workplace.STM_Workplace_ID = Workplace.STM_Workplace_ID) ON (Product.Product_Name = Product_Activity.Product_Name) AND (Product.Product_ID = Product_Activity.Product_ID) " _
& " AND (Product.Product_Name = Product_Activity.Product_Name) AND (Product.Product_ID = Product_Activity.Product_ID)) ON (Substance.Substance_Name = Proportions.Substance_Name) AND (Substance.Substance_ID = Proportions.Substance_ID)) INNER JOIN Risk_Assessment ON (Substance.Substance_Name = Risk_Assessment.Substance_Name) AND (Substance.Substance_ID = Risk_Assessment.Substance_ID) " _
& " WHERE Product_Activity.ID_Product_Task = Product_Activity_ID"

strDefaultName = CreatePivotTable(strRecordSource)

'Rename the form from its default name
Dim strFormName As String
strFormName = "TestCreatePivotTableForm"
If (AssignPivotTableName(strDefaultName, strFormName)) = False Then
    Exit Sub
End If

'Configure the PivotTable
ConfigurePivotTable (strFormName)
End Sub



Public Function AssignPivotTableName(strDefaultName As String, strFormName As String As Boolean
Dim acc1 As AccessObject

AssignPivotTableName = True

For Each acc1 In CurrentProject.AllForms
    If acc1.Name = strFormName Then
        MsgBox "Choose a form name other " & _
            "than '" & strFormName & "' that " & _
            "does not match an existing form."
        AssignPivotTableName = False
        DoCmd.DeleteObject acForm, strDefaultName
        Exit Function
    End If
Next acc1

DoCmd.Rename strFormName, acForm, strDefaultName
End Function



Public Function CreatePivotTable(strRecordSource As String) As String
Const acFormPivotTable = 3
Dim frm1 As Access.Form

Set frm1 = CreateForm
frm1.DefaultView = acFormPivotTable
frm1.RecordSource = strRecordSource

CreatePivotTable = frm1.Name
DoCmd.Close acForm, CreatePivotTable, acSaveYes
End Function



Public Sub ConfigurePivotTable(strFormName As String) 
Dim fst1 As PivotFieldSet

DoCmd.OpenForm strFormName, acFormPivotTable
Set frm1 = Forms.Item(strFormName)

With frm1.PivotTable.ActiveView
    ***Set fst1 = .FieldSets("Product_Name")***
    .FilterAxis.InsertFieldSet fst1
    Set fst1 = .FieldSets("WorkPlace_Name")
    .ColumnAxis.InsertFieldSet fst1
    Set fst1 = .FieldSets("Activity_Name")
    .RowAxis.InsertFieldSet fst1
    Set fst1 = .FieldSets("Imission_Score")
    .DataAxis.InsertFieldSet fst1
End With

DoCmd.Close acForm, frm1.Name, acSaveYes
End Sub

The problem is as follows: I am getting an error 13 Type mismatch when setting the PivotFieldSet and am clueless as to what is going wrong. The form is created with the appropriate recordset and opens in PivotTableView and that's as far as it goes. I was hoping to retrieve some suggestions as to what the problem could be.

Also, could there be another way to achieve my goal of making a matrix as described? Since an export to Excel would be needed to print out the PivotTable which is a detour I'd rather the end-user wouldn't have to take.

Thanks in advance for any suggestions or replies to my post.

Answer 1

Your aversion to using a Crosstab query is unfounded. If you have at most one observation for each row/column combination then your "summary data" is just the value itself: it doesn't matter if you use Min(), Max(), or Sum().

Example: For sample data [Risk_Data]

Activity        Workplace        Risk_Ratio
--------------  ---------------  ----------
Activity_Name   Workplace_Name          1.2
Activity_Name   Workplace_Name2         2.3
Activity_Name2  Workplace_Name          3.4
Activity_Name2  Workplace_Name2         4.5

the query

TRANSFORM Max(Risk_Ratio) AS MaxOfRisk_Ratio
SELECT Activity
FROM Risk_Data
GROUP BY Activity
PIVOT Workplace

returns

Activity        Workplace_Name  Workplace_Name2
--------------  --------------  ---------------
Activity_Name              1.2              2.3
Activity_Name2             3.4              4.5