-
Jan 27th, 2016, 10:31 AM
#1
Thread Starter
Lively Member
Using VBA to Sum rows
I am trying to put together a macro that will sum rows based on certain criteria.
The criteria is a column with Group IDs in them. I need to sum up each row with the same Group ID in it together.
So If:
Grp IDs Count
1 10
3 12
4 2
1 13
1 5
4 6
4 100
So I would need to sum up every row that has the same group ID in it, for each group ID.
How could I go about doing this?
-
Jan 27th, 2016, 11:36 AM
#2
Hyperactive Member
Re: Using VBA to Sum rows
Can you sort the data by Group ID? If so, then you can simply use the Automatic SubTotal feature of Excel. It can be found in the Data ribbon, SubTotal button in the Outline section on the right.
If the data are going to change (i.e. this needs to occur multiple times on this sheet or multiple files), then you can create a macro similar to this below. I've commented the code so you can see what it does. This presupposes that the Grp ID data begin in cell A2 with the values to sum in the corresponding cells of column B.
Hope this helps.
Nate
Code:
Sub CreateSubtotals()
Dim lngLastRow As Long
'Removes any Subtotals in the region of your data. Does NOT cause
' an error is there is no Subtotals
Range("A2").RemoveSubtotal
'Determines and stores the last data row for use in the Sort method
lngLastRow = Range("A2").End(xlDown).Row
With ActiveSheet.Sort
'Clears any previously defined sort fields
.SortFields.Clear
'Sets the sort parameters (which column, asc/desc, etc.)
.SortFields.Add Key:=Range("A2"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
'Sets the range of the data to sort
.SetRange Range("A2:B" & lngLastRow)
'Advices there are headers to use
.Header = xlYes
'Don't really need the next3 statements unless you change one of them from
' the default
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
'Applies the sort (actually does it)
.Apply
End With
'Creates the Subtotals by Groups based on changes in the data of
' the first column
Range("A2").Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(2), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
'Uses the Outline to show only the Subtotals
ActiveSheet.Outline.ShowLevels RowLevels:=2
End Sub
-
Jan 27th, 2016, 03:21 PM
#3
Re: Using VBA to Sum rows
you can also use a worksheetformula (sumif) in VBA
or you can use ADO to read the worksheet as a database, using SQL query to put results into recordsets
i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next
dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part
come back and mark your original post as resolved if your problem is fixed
pete
-
Jan 28th, 2016, 01:25 AM
#4
New Member
Re: Using VBA to Sum rows
Hi junfanbl
I am new to this forum and learning VB for Excel. Here is my solution, I will be probably get shot down in flames by the more seasoned pro's on here!
I am assuming that your data is in A1:B8. The following code extracts the unique IDs to column D and then uses the Sumif in column E.
Code:
Sub SumRows()
'Extract the unique Group IDs to column D
With Sheet1.Range("A1", Range("A1").End(xlDown))
.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("D1"), Unique:=True
.Range("D1") = "Group IDs"
End With
'SUMIF part
Dim x As Long
Dim grpID As Range
Dim CountRng As Range
Dim lrow As Long
Set grpID = Range("A2", Range("A2").End(xlDown)) 'Range A2:A8
Set CountRng = Range("B2", Range("B2").End(xlDown)) 'Range B2:B8
lrow = Cells(Rows.Count, 4).End(xlUp) - 1 'Count the number of unique ids for the For Next loop
For x = 1 To lrow
Cells(x + 1, 5) = WorksheetFunction.SumIf(grpID, Cells(x + 1, 4), CountRng)
Next x
End Sub
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|