View Single Post
  #12   Report Post  
Posted to microsoft.public.excel.programming
Claus Busch Claus Busch is offline
external usenet poster
 
Posts: 3,872
Default Multiple SUM's in a column

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
Failed Tot = 6
Invalid xxxxxxx 4
Invalid xxxxxxx 5
Invalid Tot = 9
Success xxxxxxx 6
Success xxxxxxx 7
Success xxxxxxx 8
Success Tot = 21

Which is Column A, B, C.
So in column D I need a formula that returns the % of the value in C of the respective total.


try:

Sub MultiSum()
Dim LRow As Long, i As Long
Dim mySum As Double, Total As Double
Dim strFormat As String

With ActiveSheet
LRow = .Cells(Rows.Count, 1).End(xlUp).Row
For i = LRow To 2 Step -1
If .Cells(i, 1) < .Cells(i + 1, 1) Then
.Rows(i + 1).Insert
End If
Next

LRow = .Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To LRow + 1
If Len(.Cells(i, 1)) = 0 Then
Select Case .Cells(i - 1, 1).Value
Case "Failed"
strFormat = "Failed tot = "
Case "Invalid"
strFormat = "Invalid tot = "
Case "Success"
strFormat = "Success tot = "
End Select
.Cells(i, 3) = strFormat & mySum
mySum = 0
i = i + 1
End If
If i LRow + 1 Then Exit For
mySum = mySum + CDbl(Mid(.Cells(i, 2), _
InStrRev(.Cells(i, 2), " ") + 1))
Total = Total + CDbl(Mid(.Cells(i, 2), _
InStrRev(.Cells(i, 2), " ") + 1))
Next
For i = 2 To LRow + 1
If Len(.Cells(i, 3)) 0 Then
.Cells(i, 4) = Mid(.Cells(i, 3), InStrRev(.Cells(i, 3), " ") +
1) / Total
.Cells(i, 4).NumberFormat = "0.00%"
End If
Next
End With
End Sub


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