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 0-9, 10-19, 20-21, ..., 80-89, 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 80-89. 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