mtdewrocks
New Member
- Joined
- Apr 14, 2016
- Messages
- 20
I am writing some code to generate multiple pivot tables in excel. My spreadsheet is set up with survey responses to a variety of questions with the question number across the top, and the survey responses below in the column. My problem relates to questions 8, 10, and 13. As you can see in my sample table, most questions have only one possible response so the code is pretty easy. I can also write the code to generate a pivot table for all of question 8's responses, but am trying to figure out what would be the best way to handle this situation.
I want it to generate a pivot table for questions 1 - 7, then generate one pivot table based on all question 8 responses, and then skip over i's to get to question 9. In this example I want it to get to I=8, and then skip to I=11 so it does not try to generate the pivot tables for questions 8_2, 8_3. I will also need to do this again for my question 10 and 13, but if someone can get me the coding for this one I assume it would be the same process, just different I's. My code is posted below.
Q_1 Q_2 Q_3 Q_4 Q_5......Q_8_1 Q_8_2 Q_8_3
2 1 2 4 3
3 7 5 1 2
Code
< Sub MakePivotTables()
' This procedure creates multiple pivot tables
Dim PTCache As PivotCache
Dim pt As Pivottable
Dim SummarySheet As Worksheet
Dim ItemName As String
Dim Row As Long, Col As Long, i As Long
Dim Period As String
Dim QBPRCOML As String
Application.ScreenUpdating = False
' Delete Summary sheet if it exists
On Error Resume Next
Application.DisplayAlerts = False
Sheets("Summary").Delete
On Error GoTo 0
' Add Summary sheet
Set SummarySheet = Worksheets.Add
ActiveSheet.Name = "Summary"
' Create Pivot Cache
Set PTCache = ActiveWorkbook.PivotCaches.Create( _
SourceType:=xlDatabase, _
SourceData:=Sheets("MASTER").Range("A1"). _
CurrentRegion)
Row = 3
For i = 1 To 20
For Col = 1 To 14 Step 13 '2 columns
ItemName = Sheets("MASTER").Cells(1, i + 19)
With Cells(Row, Col)
.Value = ItemName
.Font.Size = 16
End With
Period = "20160331"
QBPRCOML = "KC"
' Create pivot table
Set pt = ActiveSheet.PivotTables.Add( _
PivotCache:=PTCache, _
TableDestination:=SummarySheet.Cells(Row + 1, Col))
' Add the fields
If Col = 1 Then 'Frequency tables
With pt.PivotFields("CERT")
.Orientation = xlDataField
.Name = "Frequency"
.Function = xlCount
End With
Else ' Percent tables
With pt.PivotFields("CERT")
.Orientation = xlDataField
.Name = "Percent"
.Function = xlCount
.Calculation = xlPercentOfColumn
.NumberFormat = "0.0%"
End With
End If
pt.PivotFields("CALLYMD").Orientation = xlPageField
pt.PivotFields("CALLYMD").Position = 1
pt.PivotFields("REGION").Orientation = xlPageField
pt.PivotFields("REGION").Position = 1
pt.PivotFields("REGION").CurrentPage = QBPRCOML
With pt.PivotFields(ItemName)
.Orientation = xlRowField
.ShowAllItems = True
End With
pt.DisplayFieldCaptions = False
Next Col
Row = Row + 15
Next i
End Sub>
I want it to generate a pivot table for questions 1 - 7, then generate one pivot table based on all question 8 responses, and then skip over i's to get to question 9. In this example I want it to get to I=8, and then skip to I=11 so it does not try to generate the pivot tables for questions 8_2, 8_3. I will also need to do this again for my question 10 and 13, but if someone can get me the coding for this one I assume it would be the same process, just different I's. My code is posted below.
Q_1 Q_2 Q_3 Q_4 Q_5......Q_8_1 Q_8_2 Q_8_3
2 1 2 4 3
3 7 5 1 2
Code
< Sub MakePivotTables()
' This procedure creates multiple pivot tables
Dim PTCache As PivotCache
Dim pt As Pivottable
Dim SummarySheet As Worksheet
Dim ItemName As String
Dim Row As Long, Col As Long, i As Long
Dim Period As String
Dim QBPRCOML As String
Application.ScreenUpdating = False
' Delete Summary sheet if it exists
On Error Resume Next
Application.DisplayAlerts = False
Sheets("Summary").Delete
On Error GoTo 0
' Add Summary sheet
Set SummarySheet = Worksheets.Add
ActiveSheet.Name = "Summary"
' Create Pivot Cache
Set PTCache = ActiveWorkbook.PivotCaches.Create( _
SourceType:=xlDatabase, _
SourceData:=Sheets("MASTER").Range("A1"). _
CurrentRegion)
Row = 3
For i = 1 To 20
For Col = 1 To 14 Step 13 '2 columns
ItemName = Sheets("MASTER").Cells(1, i + 19)
With Cells(Row, Col)
.Value = ItemName
.Font.Size = 16
End With
Period = "20160331"
QBPRCOML = "KC"
' Create pivot table
Set pt = ActiveSheet.PivotTables.Add( _
PivotCache:=PTCache, _
TableDestination:=SummarySheet.Cells(Row + 1, Col))
' Add the fields
If Col = 1 Then 'Frequency tables
With pt.PivotFields("CERT")
.Orientation = xlDataField
.Name = "Frequency"
.Function = xlCount
End With
Else ' Percent tables
With pt.PivotFields("CERT")
.Orientation = xlDataField
.Name = "Percent"
.Function = xlCount
.Calculation = xlPercentOfColumn
.NumberFormat = "0.0%"
End With
End If
pt.PivotFields("CALLYMD").Orientation = xlPageField
pt.PivotFields("CALLYMD").Position = 1
pt.PivotFields("REGION").Orientation = xlPageField
pt.PivotFields("REGION").Position = 1
pt.PivotFields("REGION").CurrentPage = QBPRCOML
With pt.PivotFields(ItemName)
.Orientation = xlRowField
.ShowAllItems = True
End With
pt.DisplayFieldCaptions = False
Next Col
Row = Row + 15
Next i
End Sub>