PDA

View Full Version : Solved: Macro to Sum values in Range to new Column



Kvelocity
09-03-2008, 11:12 AM
So I started working with Macros last week and I'm still figuring out how they work to process my datasheets. I have most of it figured out but I'm stuck on one last calculation.
I have several ranges of items in a sheet that take up multiple rows. I need to get the total of each group and put it in the first row of the group. I tried the build in "Subtotal" function but that puts the total in the wrong place.

Here's the layout

Column1 Column 2 Column3
a Total A
a 3
a 4
a 2
b Total B
b 3
b 3
b 3

I know this on is probably an easy one but....

Thanks in advance.

Bob Phillips
09-03-2008, 11:26 AM
Do you mean overwrite the first value with the sum of that group? Sum with or without the first value?

CreganTur
09-03-2008, 11:28 AM
(Please delete Double-post)

CreganTur
09-03-2008, 11:29 AM
Use the following Function- put it in a Module.

Function TotalA(rng1 As Range)

Dim Cell As Range
Dim Total As Double

Application.Volatile '<<<Makes function run whenever sheet recalculates
For Each cell In rng1
Total = Total + Cell.Value
Next

TotalA = Total

End Function

Just put =Total(***Range***) wherever you want to get a total. Just be sure to replace '***Range*** with the actuall cell ranges you want to work with.

Kvelocity
09-03-2008, 11:31 AM
oops...new to the forums too. That didn't format right.
Column 1 has the repeating data that creates the group.
Column 2 has the Value that needs to be totaled
Column 3 - Row 1 of each group is where I need the total to go.
Thanks

Bob Phillips
09-03-2008, 11:44 AM
Public Sub ProcessData()
Dim i As Long
Dim LastRow As Long
Dim EndRow As Long
Dim sh As Worksheet

Application.ScreenUpdating = False

With ActiveSheet

.Rows(1).Insert
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = LastRow To 2 Step -1

If .Cells(i, "A").Value <> .Cells(i - 1, "A").Value Then

.Cells(i, "C").Formula = "=SUMIF(A:A,A" & i & ",B:B)"
End If
Next i
.Rows(1).Delete
End With

Application.ScreenUpdating = True

End Sub

Kvelocity
09-03-2008, 12:01 PM
You guys are awesome!!! :beerchug: