Hi Howard,

Am Thu, 6 Nov 2014 18:16:45 -0800 (PST) schrieb L. Howard:

Status Message Volume
Failed xxxxxxx 1
Failed xxxxxxx 2
Failed xxxxxxx 3
Invalid xxxxxxx 4
Invalid xxxxxxx 5
Success xxxxxxx 6
Success xxxxxxx 7
Success xxxxxxx 8

I am sorry but I misunderstood your layout. I thought the numbers are in
column B behind the string. That causes that the two previous answers
are wrong.

Try:
Sub MultiSum()
Dim LRow As Long, i As Long
Dim mySum As Double, Total As Double

Application.ScreenUpdating = False
With ActiveSheet
LRow = .Cells(Rows.Count, 1).End(xlUp).Row
'Insert rows when value in A changes
For i = LRow To 2 Step -1
If .Cells(i, 1) < .Cells(i + 1, 1) Then
.Rows(i + 1).Insert
End If
Next
'Calculating the sum of each item
'and the % for each total
LRow = .Cells(Rows.Count, 1).End(xlUp).Row
Total = WorksheetFunction.Sum(Range("C:C"))
For i = 2 To LRow + 1
If Len(.Cells(i, 1)) = 0 Then
.Cells(i, 3) = .Cells(i - 1, 1) & " tot = " & mySum
.Cells(i, 4) = mySum / Total
.Cells(i, 4).NumberFormat = "0.00%"
mySum = 0
i = i + 1
End If
If i LRow + 1 Then Exit For
mySum = mySum + .Cells(i, 3)
Next
End With
Application.ScreenUpdating = True
End Sub


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional