OK, I have a question, I have a survey with a lot of questions ordered in columns. The first line of the column is the question itself and the following lines are the answers from the different participants. I want to have an overview how many times each answer is given (e.g. 5x yes and 2x no or 4x agree and 3x agree). So I want to write a macro that creates in a result sheet for every column 1) a pivot table in which the answers are counted (so in rows the field of the respective question and in values the count of the respective question). 2) Two graphs: a pie chart and a bar chart of these results. I tried to write a VBA code, but have two problems. It bugs at the second pivot table and it does not really continue to the end of questions (it halts at 3). Can someone help me? Thanks in advance!
VBA Code:
Sub Macro2()'' Macro2 Macro'' ActiveWindow.ScrollColumn = 5 ActiveWindow.ScrollColumn = 4 ActiveWindow.ScrollColumn = 3 ActiveWindow.ScrollColumn = 1 Columns("A:A").Select Sheets.Add After:=ActiveSheet Sheets("Sheet8").Select Sheets("Sheet8").Name = "Result" Range("A1").Select Application.CutCopyMode = False ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _ "Survey!R1C1:R1048576C1", Version:=8).CreatePivotTable TableDestination:= _ "Result!R1C1", TableName:="PivotTable3", DefaultVersion:=8 Sheets("Result").Select Cells(1, 1).Select With ActiveSheet.PivotTables("PivotTable3") .ColumnGrand = True .HasAutoFormat = True .DisplayErrorString = False .DisplayNullString = True .EnableDrilldown = True .ErrorString = "" .MergeLabels = False .NullString = "" .PageFieldOrder = 2 .PageFieldWrapCount = 0 .PreserveFormatting = True .RowGrand = True .SaveData = True .PrintTitles = False .RepeatItemsOnEachPrintedPage = True .TotalsAnnotation = False .CompactRowIndent = 1 .InGridDropZones = False .DisplayFieldCaptions = True .DisplayMemberPropertyTooltips = False .DisplayContextTooltips = True .ShowDrillIndicators = True .PrintDrillIndicators = False .AllowMultipleFilters = False .SortUsingCustomLists = True .FieldListSortAscending = False .ShowValuesRow = False .CalculatedMembersInFilters = False .RowAxisLayout xlCompactRow End With With ActiveSheet.PivotTables("PivotTable3").PivotCache .RefreshOnFileOpen = False .MissingItemsLimit = xlMissingItemsDefault End With ActiveSheet.PivotTables("PivotTable3").RepeatAllLabels xlRepeatLabels ActiveSheet.PivotTables("PivotTable3").AddDataField ActiveSheet.PivotTables( _ "PivotTable3").PivotFields("Response ID"), "Sum of Response ID", xlSum With ActiveSheet.PivotTables("PivotTable3").PivotFields("Response ID") .Orientation = xlRowField .Position = 1 End With With ActiveSheet.PivotTables("PivotTable3").PivotFields("Sum of Response ID") .Caption = "Count of Response ID" .Function = xlCount End With ActiveSheet.Shapes.AddChart2(251, xlPie).Select ActiveChart.SetSourceData Source:=Range("Result!$A$1:$B$11") ActiveSheet.Shapes("Chart 1").IncrementLeft -90.75 ActiveSheet.Shapes("Chart 1").IncrementTop -169.1249606299 Rows("11:11").RowHeight = 75.75 ActiveSheet.Shapes("Chart 1").ScaleWidth 0.9895833333, msoFalse, _ msoScaleFromBottomRight ActiveSheet.Shapes("Chart 1").ScaleHeight 0.837398374, msoFalse, _ msoScaleFromTopLeft ActiveChart.ChartTitle.Select Range("M3").Select ActiveSheet.Shapes.AddChart2(201, xlColumnClustered).Select ActiveSheet.Shapes("Chart 2").IncrementLeft 123 ActiveSheet.Shapes("Chart 2").IncrementTop -116.25 ActiveChart.Parent.Delete Range("A1").Select ActiveSheet.Shapes.AddChart2(201, xlColumnClustered).Select ActiveChart.SetSourceData Source:=Range("Result!$A$1:$B$11") ActiveSheet.Shapes("Chart 3").IncrementLeft 286.5 ActiveSheet.Shapes("Chart 3").IncrementTop -157.5 Range("A16").Select Application.CutCopyMode = False ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _ "Survey!R1C2:R1048576C2", Version:=8).CreatePivotTable TableDestination:= _ "Result!R16C1", TableName:="PivotTable4", DefaultVersion:=8 Sheets("Result").Select Cells(16, 1).Select With ActiveSheet.PivotTables("PivotTable4") .ColumnGrand = True .HasAutoFormat = True .DisplayErrorString = False .DisplayNullString = True .EnableDrilldown = True .ErrorString = "" .MergeLabels = False .NullString = "" .PageFieldOrder = 2 .PageFieldWrapCount = 0 .PreserveFormatting = True .RowGrand = True .SaveData = True .PrintTitles = False .RepeatItemsOnEachPrintedPage = True .TotalsAnnotation = False .CompactRowIndent = 1 .InGridDropZones = False .DisplayFieldCaptions = True .DisplayMemberPropertyTooltips = False .DisplayContextTooltips = True .ShowDrillIndicators = True .PrintDrillIndicators = False .AllowMultipleFilters = False .SortUsingCustomLists = True .FieldListSortAscending = False .ShowValuesRow = False .CalculatedMembersInFilters = False .RowAxisLayout xlCompactRow End With With ActiveSheet.PivotTables("PivotTable4").PivotCache .RefreshOnFileOpen = False .MissingItemsLimit = xlMissingItemsDefault End With ActiveSheet.PivotTables("PivotTable4").RepeatAllLabels xlRepeatLabels ActiveWindow.SmallScroll Down:=3 With ActiveSheet.PivotTables("PivotTable4").PivotFields("First Name") .Orientation = xlRowField .Position = 1 End With ActiveSheet.PivotTables("PivotTable4").AddDataField ActiveSheet.PivotTables( _ "PivotTable4").PivotFields("First Name"), "Count of First Name", xlCount ActiveSheet.Shapes.AddChart2(251, xlPie).Select Range("B26").Select ActiveSheet.ChartObjects("Chart 4").Activate Range("N26").Select ActiveWindow.SmallScroll Down:=-9 ActiveSheet.ChartObjects("Chart 4").Activate ActiveSheet.ChartObjects("Chart 4").Activate ActiveSheet.Shapes("Chart 4").ScaleHeight 0.8819627255, msoFalse, _ msoScaleFromBottomRight Range("A16").Select ActiveSheet.ChartObjects("Chart 4").Activate Range("A16").Select ActiveSheet.Shapes.AddChart2(201, xlColumnClustered).Select ActiveChart.SetSourceData Source:=Range("Result!$A$16:$B$26") ActiveSheet.Shapes("Chart 5").IncrementLeft 279.75 ActiveSheet.Shapes("Chart 5").IncrementTop 138.75 ActiveWindow.SmallScroll Down:=10 Range("B29").Select ActiveWindow.SmallScroll Down:=0 Range("A32").Select ActiveWindow.SmallScroll Down:=0 Range("A31").Select Application.CutCopyMode = False ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _ "Survey!R1C3:R1048576C3", Version:=8).CreatePivotTable TableDestination:= _ "Result!R31C1", TableName:="PivotTable5", DefaultVersion:=8 Sheets("Result").Select Cells(31, 1).Select With ActiveSheet.PivotTables("PivotTable5") .ColumnGrand = True .HasAutoFormat = True .DisplayErrorString = False .DisplayNullString = True .EnableDrilldown = True .ErrorString = "" .MergeLabels = False .NullString = "" .PageFieldOrder = 2 .PageFieldWrapCount = 0 .PreserveFormatting = True .RowGrand = True .SaveData = True .PrintTitles = False .RepeatItemsOnEachPrintedPage = True .TotalsAnnotation = False .CompactRowIndent = 1 .InGridDropZones = False .DisplayFieldCaptions = True .DisplayMemberPropertyTooltips = False .DisplayContextTooltips = True .ShowDrillIndicators = True .PrintDrillIndicators = False .AllowMultipleFilters = False .SortUsingCustomLists = True .FieldListSortAscending = False .ShowValuesRow = False .CalculatedMembersInFilters = False .RowAxisLayout xlCompactRow End With With ActiveSheet.PivotTables("PivotTable5").PivotCache .RefreshOnFileOpen = False .MissingItemsLimit = xlMissingItemsDefault End With ActiveSheet.PivotTables("PivotTable5").RepeatAllLabels xlRepeatLabels ActiveWindow.SmallScroll Down:=3 Range("A31").Select ActiveSheet.Shapes.AddChart2(201, xlColumnClustered).Select ActiveChart.SetSourceData Source:=Range("Result!$A$31:$B$41") ActiveSheet.Shapes("Chart 7").IncrementLeft 278.25 ActiveSheet.Shapes("Chart 7").IncrementTop 140.25 ActiveWindow.SmallScroll Down:=3 Range("B32").Select ActiveWindow.SmallScroll Down:=3End Sub
