' ******************************************
' *                                        *
' *   Fichier STEMLEAF.TXT                 *
' *                                        *
' ******************************************

' macro by Nick Maxwell, Data Matters Resource Center, 2003;
' debugging and workbook by Gaj Vidmar, IBMI, 2004
' data : whole numbers, starting from row 2, must be sorted.


' ==================================================

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 <= 10
  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) < 5 Then divisor = divisor * 10

'Calculate the top stem's value.
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 rowPointer

shrinkFactor = Fix(maximumCount / 50)
If shrinkFactor < 1 Then shrinkFactor = 1
Cells(1, 4).Value = "Each digit represents" + Str(shrinkFactor) + " case(s)."

'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

' ==================================================


' === fin de fichier STEMLEAF.TXT