PDA

View Full Version : Solved: Sum rows according to column condition



ulfal028
06-14-2006, 02:24 AM
I have x number of rows, sorted according to column J condition. There are x number of conditions. What I'm looking for is:

Whenever the column J condition change, insert a row and:
- sum column H for the rows above
- insert the text "Total [& condition]" in column B.

Then do the exact same thing for the next condition, and so on. I've attached an example, and would kindly accept some help on this one.

[Added]
Well, I found the solution in Excel; subtotals. The layout is not exactly what I was looking for, but it will do:
Range("B1:J355").Subtotal GroupBy:=8, Function:=xlSum, TotalList:=Array(7), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True

Norie
06-14-2006, 06:38 AM
Try this.

Dim rng As Range
Dim s As Long

Set rng = Range("I2")
s = 2
While rng.Value <> ""
If rng.Value <> rng.Offset(1) Then
rng.Offset(1).EntireRow.Insert
rng.Offset(1, -7) = "Total " & rng.Value
rng.Offset(1, -1) = Application.WorksheetFunction.Sum(Range("H" & s).Resize(rng.Row - s + 1))
Set rng = rng.Offset(1)
s = rng.Row + 1
End If
Set rng = rng.Offset(1)
Wend

Shazam
06-14-2006, 06:38 AM
Here is a pieace of code I paste together its not everything you ask but it might get you started.




Sub InsertRow()
Dim i As Long
For i = Cells(2 ^ 16, 9).End(xlUp).Row To 3 Step -1
If Cells(i, 9).Value <> Cells(i - 1, 9).Value Then
Rows(i).Insert
Else
End If
Next i
For Each NumRange In Columns("H").SpecialCells(xlConstants, xlNumbers).Areas
SumAddr = NumRange.Address(False, False)
NumRange.Offset(NumRange.Count, 0).Resize(1, 1).Formula = "=DOLLAR(SUM(" & SumAddr & "))"
c = NumRange.Count
Next NumRange
NoData:
Db = """"
maxrow = Range("H65536").End(xlUp).Row
MyFormula = "=DOLLAR(SUMIF(I2:I" & maxrow & "," & """=""" & ",H2:H" & maxrow & "))"
Range("H" & maxrow + 1) = MyFormula

End Sub

ulfal028
06-14-2006, 06:53 AM
Thank you Norie and Shazam, both examples worked fine.

Regarding to Nories code:
- Could you change the subtotal rows to bold (font)
- Add a "Total" sum beneath the last subtotal row?

Thanks in advance!

Norie
06-14-2006, 07:08 AM
Try this.

Dim rng As Range
Dim s As Long
Dim LastRow As Long

Set rng = Range("I2")
LastRow = rng.End(xlDown).Row
rng.Offset(LastRow - 1, -1) = Application.WorksheetFunction.Sum(Range("H2").Resize(LastRow - 1))

s = 2
While rng.Value <> ""
If rng.Value <> rng.Offset(1) Then
rng.Offset(1).EntireRow.Insert
rng.Offset(1, -7) = "Total " & rng.Value
rng.Offset(1, -1) = Application.WorksheetFunction.Sum(Range("H" & s).Resize(rng.Row - s + 1))
rng.Offset(1).EntireRow.Font.Bold = True
Set rng = rng.Offset(1)
s = rng.Row + 1
End If
Set rng = rng.Offset(1)
Wend
rng.Offset(0, -7) = "Total All" & rng.Value

ulfal028
06-14-2006, 07:30 AM
Works perfect, Norie. Thank you very much!