[Solved] Breaking down sums into frequency (for histogram)

by


This should do the trick. If not, it will at least get you started.

 Sub Expand_Occurance()
    Dim ItemCounter As Long, shBottom As Long, NewItemRow As Long, OccuranceCounter As Long
    Dim sh As Worksheet
    Set sh = ActiveSheet
    shBottom = sh.Cells(Rows.Count, 1).End(xlUp).Row 'get the bottom row of column 1
    NewItemRow = shBottom + 1 'and the first new row to write to

    For ItemCounter = 2 To shBottom
        If sh.Cells(ItemCounter, 2) > 1 Then 'there's more than one occurance
            'this could probably be more elegant, but it works
            Do While sh.Cells(ItemCounter, 2) > 1
                sh.Range(sh.Cells(ItemCounter, 1), sh.Cells(ItemCounter, 3)).Copy destination:=sh.Cells(NewItemRow, 1)
                sh.Cells(NewItemRow, 2) = 1
                NewItemRow = NewItemRow + 1
            sh.Cells(ItemCounter, 2) = sh.Cells(ItemCounter, 2) - 1
            Loop
        End If
    Next ItemCounter

'then sort the results
    shBottom = sh.Cells(Rows.Count, 1).End(xlUp).Row 'get the new bottom row
    sh.Sort.SortFields.Clear
    sh.Sort.SortFields.Add Key:=Range("A2:A" & shBottom), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With sh.Sort
        .SetRange sh.Range("A1:C" & shBottom)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    End Sub

1

solved Breaking down sums into frequency (for histogram)