1. Rename a blank Excel worksheet “Data” by clicking the bottom tab for the worksheet and typing the new name.
2. Rename another blank Excel worksheet in the workbook “Stem” by clicking the bottom tab for that worksheet and typing the new name.
3. Enter your list of numbers in column A of the “Data” worksheet.
4. Press “Alt” and “F11” at the same time to open the visual basic editor.
5. Double click “This Workbook” under Microsoft Excel Objects in the left navigation pane to open a blank code window.
6. Paste the following VBA code into the blank window:
Sub StemAndLeaf()
dataColumn = 1'Clean everything out of the Stem worksheet.
Worksheets('Stem').Cells.Clear'Look at the Data worksheet.
Worksheets('Data').Activate'Find the maximum value.
rowPointer = 2
Do Until Cells(rowPointer, 1).Value = ''
rowPointer = rowPointer 1
Loop
Maximum = Cells(rowPointer - 1, dataColumn).Value'Set the divisor to strip off leaves.
divisor = 1
Do Until Maximum / divisor
divisor = divisor * 10
Loop'If the first digit of the largest value is less than 5, then
'use a smaller divisor.
'Otherwise you could end up with four or fewer rows in the plot.
If Fix(Maximum / divisor)
topStem = Fix(Maximum / divisor)'Set up the Stem worksheet.
Worksheets('Stem').Activate
Cells(1, 1).Value = 'Count'
Cells(1, 2).Value = 'Stem'
Cells(1, 3).Value = 'Leaves'
For rowPointer = 2 To topStem 2
Cells(rowPointer, 2).Value = rowPointer - 2
Cells(rowPointer, 3).Value = '|'
Next rowPointer'Calculate the counts.
'The following code is slower than it needs to be,
'but a faster code would be harder to read and understand.
Worksheets('Data').Activate
rowPointer = 2
Do Until Cells(rowPointer, dataColumn).Value = ''
measurement = Cells(rowPointer, dataColumn).Value
Stem = Fix(measurement / divisor)
Worksheets('Stem').Cells(Stem 2, 1).Value = Worksheets('Stem').Cells(Stem 2, 1).Value 1
rowPointer = rowPointer 1
Loop'Calculate the shrink factor.
Worksheets('Stem').Activate
maximumCount = 0
For rowPointer = 2 To topStem 2
If Cells(rowPointer, 1).Value > maximumCount Then
maximumCount = Cells(rowPointer, 1).Value
End If
Next rowPointershrinkFactor = Fix(maximumCount / 50)
If shrinkFactor
Cells(1, 4).Value = 'Each digit represents' Str(shrinkFactor) ' cases.''Return to the data, and fill the leaves in light of the values in the data.
Worksheets('Data').Activate
rowPointer = 2
Do Until Cells(rowPointer, dataColumn).Value = ''
measurement = Cells(rowPointer, dataColumn).Value
Stem = Fix(measurement / divisor)
leaf = measurement - Stem * divisor
leaf = Fix(leaf * 10 / divisor)Worksheets('Stem').Cells(Stem 2, 3).Value = Worksheets('Stem').Cells(Stem 2, 3).Value Trim(Str(leaf))
rowPointer = rowPointer shrinkFactor
Loop'Get to the Stem worksheet.
Worksheets('Stem').Activate
End Sub
7. Press “F5” to run the code. Your Stem and Leaf plot will appear in the “Stem” worksheet.
Read more ►