excel – VBA Macro to change vertical axis in column chart to the minimum and maximum values in selection

If you have the Analysis Toolpak loaded in Excel, you can transform your data into a histogram before you create the chart.

On the ‘Data’ tab of the ribbon, there will be ‘Data Analysis’ in the ‘Analysis’ panel. Click on this, and choose Histogram from the list.

A wizard will start that asks for the data range, the bin range, and the output range. You can set up your bin range beforehand, which in your case would just be the numbers 1 through 5. When your data gets more complex, you can use the MIN and MAX worksheet functions to help determine your bins.

You’ll notice in the picture above that the bin range is defined with 1 blank cell above the actual data. Excel needs this extra row, but I’m not sure why. EDIT The blank row is so that you can label your bins with a column heading.

Once you have the output (green cells) you can easily plot that as a bar chart.

You can do all this in vba code if you want (I have in the past) but it involves some serious vba coding. I would recommend sticking with Excel’s built-in functionality unless you really need to automate the entire process.

EDIT

There is a Code Project Article/Tip/Trick located here that should get you almost all of the way to automating your solution.

For posterity, I created a Macro that produces a histogram, assuming the number of bins = 5 (as in a response to a survey question).

' Make a histogram from the selected values.
' The top value is used as the histogram's title.
Sub MakeHistogramFinal()
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 = InputBox(Prompt:="Enter Title for Histogram", _
          title:="Title Submission Form", Default:="Morning Session Summary")
    new_sheet.Name = title


    ' Copy the scores to the new sheet.
    new_sheet.Cells(1, 1) = "Data"
    r = 2
    For Each score_cell In selected_range.Cells
        new_sheet.Cells(r, 1) = score_cell
        r = r + 1
    Next score_cell
    num_scores = selected_range.Count


    'Creates the number of bins to 5
    'IDEA LATER: Make this number equal to Form data
    Dim num_bins As Integer
    num_bins = 5

    ' Make the bin separators.
    new_sheet.Cells(1, 2) = "Bins"
    For r = 1 To num_bins
        new_sheet.Cells(r + 1, 2) = Str(r)
    Next r

    ' Make the counts.
    new_sheet.Cells(1, 3) = "Counts"
    Set count_range = new_sheet.Range("C2:C" & num_bins + 1)

    'Creates frequency column for all counts
    count_range.FormulaArray = "=FREQUENCY(A2:A" & num_scores + 1 & ",B2:B" & num_bins & ")"

    'Make the range labels.
    new_sheet.Cells(1, 4) = "Ranges"
    For r = 1 To num_bins
        new_sheet.Cells(r + 1, 4) = Str(r)
        new_sheet.Cells(r + 1, 4).HorizontalAlignment = _
            xlRight
    Next r

    ' 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
        .HasLegend = False
        .ChartTitle.Characters.Text = title
        .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