

Title  Use VBA code to make a quiz score histogram in Excel 
Description  This example shows how to use VBA code to make a quiz score histogram in Excel. 
Keywords  Excel, Office, score, quiz, histogram, VBA 
Categories  Office 


Unfortunately it's not completely trivial to make a histogram in Excel. This code makes a new worksheet holding a histogram for a set of quiz scores. To use the code, select the quiz scores including their column heading and click the Make Histogram button.
The code starts by creating the new worksheet and copying the quiz scores onto it. It then makes bins to count the scores. This example makes 10 bins to score values 09, 1019, 2021, ..., 8089, and 90 or more.
Next the code uses the FREQUENCY worksheet function to count the scores in each bin. Parameters to this function tell it where to find the scores to count and where to find the bin cutoff numbers. For example, if two adjacent bins have cutoff numbers is 79 and 89, then the bin counts the values between 79 + 1 = 80.
The program then creates a list of score ranges. This is just a reformatting of the bin cutoff values. For example, instead of saying 89 this value says 8089. The code aligns each of these range strings on the right.
The code next adds a chart to the new worksheet, specifying the counts as the chart's data source, and it formats the chart to look like a histogram. The SeriesCollection statement makes the chart use the range strings to label the X axis.
Finally the code places the scores' average and standard deviation on the worksheet.


' Make a histogram from the selected values.
' The top value is used as the histogram's title.
Sub MakeHistogram()
Dim src_sheet As Worksheet
Dim new_sheet As Worksheet
Dim selected_range As Range
Dim title As String
Dim r As Integer
Dim score_cell As Range
Dim num_scores As Integer
Dim count_range As Range
Dim new_chart As Chart
' Add a new sheet.
Set selected_range = Selection
Set src_sheet = ActiveSheet
Set new_sheet = Application.Sheets.Add(After:=src_sheet)
title = selected_range.Cells(1, 1)
new_sheet.Name = title & " Histogram"
' Copy the scores to the new sheet.
r = 1
For Each score_cell In selected_range.Cells
If Not IsNumeric(score_cell.Text) Then
new_sheet.Cells(r, 1) = title & " Scores"
Else
new_sheet.Cells(r, 1) = score_cell
End If
r = r + 1
Next score_cell
num_scores = selected_range.Count
' See how many bins we will have.
' (This assumes scores go from 0 to 100.)
Const BIN_SIZE As Integer = 10
Dim num_bins As Integer
num_bins = 100 \ BIN_SIZE
' Make the bin separators.
new_sheet.Cells(1, 2) = "Bins"
For r = 1 To num_bins  1
new_sheet.Cells(r + 1, 2) = r * BIN_SIZE  1
Next r
' Make the counts.
new_sheet.Cells(1, 3) = "Counts"
Set count_range = new_sheet.Range("C2:C" & num_bins + 1)
count_range.FormulaArray = "=FREQUENCY(A2:A" & _
num_scores & ",B2:B" & num_bins & ")"
' Make the range labels.
new_sheet.Cells(1, 4) = "Ranges"
For r = 1 To num_bins  1
new_sheet.Cells(r + 1, 4) = "'" & _
10 * (r  1) & "" & _
10 * (r  1) + 9
new_sheet.Cells(r + 1, 4).HorizontalAlignment = _
xlRight
Next r
r = num_bins
new_sheet.Cells(r + 1, 4) = "'" & _
10 * (r  1) & "100"
new_sheet.Cells(r + 1, 4).HorizontalAlignment = xlRight
' Make the chart.
Set new_chart = Charts.Add()
With new_chart
.ChartType = xlColumnClustered
.SetSourceData Source:=new_sheet.Range("C2:C" & _
num_bins + 1), _
PlotBy:=xlColumns
.Location Where:=xlLocationAsObject, _
Name:=new_sheet.Name
End With
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = title & " Histogram"
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, _
xlPrimary).AxisTitle.Characters.Text = "Scores"
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text _
_
= "Count"
' Display score ranges on the X axis.
.SeriesCollection(1).XValues = "='" & _
new_sheet.Name & "'!R2C4:R" & _
num_bins + 1 & "C4"
End With
ActiveChart.SeriesCollection(1).Select
With ActiveChart.ChartGroups(1)
.Overlap = 0
.GapWidth = 0
.HasSeriesLines = False
.VaryByCategories = False
End With
r = num_scores + 2
new_sheet.Cells(r, 1) = "Average"
new_sheet.Cells(r, 2) = "=AVERAGE(A1:A" & num_scores & _
")"
r = r + 1
new_sheet.Cells(r, 1) = "StdDev"
new_sheet.Cells(r, 2) = "=STDEV(A1:A" & num_scores & ")"
End Sub


For more information on programming for Office applications, see my book Microsoft Office Programming: A Guide for Experienced Developers.





