Go Premium for a chance to win a PS4. Enter to Win

x
Solved

# VBA Code to Total Columns by Groups

Posted on 2009-05-06
Medium Priority
361 Views
For each Column Sum the total and
Depending upon the number of Groups
Sumif the Total for each Group under the Column Total
The column number is fixed but the number of groups can vary
0
Question by:llawrenceg
• 5
• 4
• 4
• +1

LVL 19

Expert Comment

ID: 24318761
It would be helpful to have the worksheet that you are trying to sum
-David251
0

LVL 19

Expert Comment

ID: 24319285
In absence of the file perhaps this will help you a bit.

Select the range including the column header of the single column which has the Group Names.

Then adjust the intColumnSumOffset.  This is the data you want to sum.

So if your group column is C1:C10 and the data is D1:D10 then intColumnSumOffset=1 since D is one column to the left of C

HTH,

-David251
``````Sub subFilterUniqueSubtotal()

Dim intColumnSumOffset As Integer
'Enter an offset for column to sum
intColumnSumOffset = 1

Dim rng As Range
Set rng = Selection

If rng.Columns.Count > 1 Then
MsgBox "You have selected more than one column. Aborting", vbOKOnly
Exit Sub
End If
If rng.Rows.Count = 1 Then
Exit Sub
End If

Dim rngDest As Range

Set rngDest = Cells(rng.Row + rng.Rows.Count + 4, rng.Column)
rngDest.ClearContents
Range(rngDest.Offset(1, intColumnSumOffset), _
rngDest.End(xlDown).Offset(0, intColumnSumOffset)).Formula = "=SUMPRODUCT((" & rngDest.Offset(1, 0).Address(False, True) & "=" & rng.Offset(1, 0).Address & ")*" & rng.Offset(1, intColumnSumOffset).Address(True, False) & ")"

End Sub
``````
0

LVL 45

Expert Comment

ID: 24319713
llawrenceg,

Please ask for one of these questions to be deleted as you cannot off more than 500 points for a question.
http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q__24386395.html
For each Column Sum the total and
Depending upon the number of Groups
Sumif the Total for each Group under the Column Total
The column number is fixed but the number of groups can vary
http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q__24386398.html
For each Column Sum the total and
Depending upon the number of Groups
Sumif the Total for each Group under the Column Total
The column number is fixed but the number of groups can vary
Patrick

0

Author Comment

ID: 24319907
Attached is a Sample file to work with and some of the code I have tried
``````Sub CreateTotals2()

Dim t As Integer
Dim c As Range
Dim col As Integer
Dim cols As Integer

Set c = ActiveSheet.Cells(Cells.Rows.Count, 29).End(xlUp).Offset(1, 0)
col = ActiveSheet.Cells(1, Cells.Columns.Count).End(xlToLeft).Column

For t = 0 To 5

If t = 0 Then
c = "Totals"
For col = 30 To 36
c.Offset(0, col - 1) = "=ROUND(SUM(" & Cells(1, col).Address(False, False) & ":" & c.Offset(-1, col - 1).Address(False, False) & "),2)"
Next col
Else
c.Offset(t, 0) = "Group " & t & " Total"
For col = 30 To 36
c.Offset(t, col - 1) = "=ROUND(SUMIF(AC5:AC" & c.Row - 1 & ",""" & "=" & t & """," & Cells(1, col).Address(False, False) & ":" & c.Offset(-1, col - 1).Address(False, False) & "),2)"
Next col
End If

Next t

End Sub
``````
Book2.xls
0

Author Comment

ID: 24319988
The main issue is that the code needs to determine the number of groups and run alog side some other coding
0

LVL 33

Expert Comment

ID: 24320000
Did you've checked my file on the other duplicate question? See if this is what you want to do.

jppinto

Q24386398.xls
0

LVL 19

Expert Comment

ID: 24320022
That is precisely what my code does.

It auto filters the unique values from your data.
0

LVL 19

Expert Comment

ID: 24320075
Try this:
``````Sub subFilterUniqueSubtotal()

Dim intColumnSumOffset As Integer
'Enter an offset for column to sum
intColumnSumOffset = 1

Dim rng As Range

Dim rngDest As Range

Set rngDest = Cells(rng.Row + rng.Rows.Count + 2, rng.Column)
rngDest.ClearContents

for  intColumnSumOffset = 1 to 7
Range(rngDest.Offset(1, intColumnSumOffset), _
rngDest.End(xlDown).Offset(0, intColumnSumOffset)).Formula = "=SUMPRODUCT((" & rngDest.Offset(1, 0).Address(False, True) & "=" & rng.Offset(1, 0).Address & ")*" & rng.Offset(1, intColumnSumOffset).Address(True, False) & ")"
next intColumnSumOffset
End Sub
``````
0

Author Comment

ID: 24327452
David:
I tried your code and it just repeats all of the rows  down below the existing rows.
There needs to be a total for each column  then
below the total for each column there needs to be a total for each group for each column

Total             xxxxxx  xxxxxx xxxxxx xxxxxx xxxxxx xxxxxx xxxxxx
Group1 Total xxxxxx xxxxxx xxxxxx xxxxxx xxxxxx xxxxxx  xxxxxx
Group2 Total xxxxxx xxxxxx xxxxxx  xxxxxx xxxxxx xxxxxx xxxxxx
Group3  Total xxxxxx xxxxxx xxxxxx  xxxxxx xxxxxx xxxxxx xxxxxx
etc                  etc          etc        etc
0

LVL 45

Expert Comment

ID: 24331714
llawrenceg,
The macro below is in the attached file. ALT+F8 to select and run the macro. It will cope with different numbers of groups automatically.
Hope it helps
Patrick

``````Sub specialmacro()
Dim rng As Range
Dim celle As Range
Dim str1 As String
Dim str2 As String
Dim rowe As Long
Dim lastrow As Long
Dim i As Long
Dim n As Long
Dim coll As New Collection

With Sheets("Sheet1")
For i = 5 To 1000
If .Cells(i, "B") = "Total" Then
lastrow = i - 1
Exit For
End If
Next i

For i = 1 To 7
.Cells(lastrow + 1, i + 2).FormulaR1C1 = "=SUM(R5C:R[-1]C)"
Next i

Set rng = Range(.Cells(5, "B"), .Cells(lastrow, "B"))

For Each celle In rng
On Error Resume Next
Next celle

For i = 1 To coll.Count
.Cells(lastrow + 2 + i, "B") = --coll(i)
Next i

For i = 1 To coll.Count
For n = 3 To 9
.Cells(lastrow + 2 + i, n).FormulaR1C1 = "=SUMIF(R5C2:R22C2,RC2,R5C:R22C)"
Next n
Next i

For n = 3 To 9
.Cells(lastrow + 2 + coll.Count + 1, n).FormulaR1C1 = "=SUM(R[" & -coll.Count & "]C:R[-1]C)"
Next n

End With

End Sub
``````
llawrenceg-01.xls
0

Author Comment

ID: 24347079
The "Total" and "Group Total " Labels need to be addd to the Column as the number of items in the column is vaiiable
0

LVL 45

Accepted Solution

patrickab earned 2000 total points
ID: 24347167
llawrenceg,
See attached file.
Patrick

``````Sub specialmacro()
Dim rng As Range
Dim celle As Range
Dim str1 As String
Dim str2 As String
Dim rowe As Long
Dim lastrow As Long
Dim i As Long
Dim n As Long
Dim coll As New Collection

Application.ScreenUpdating = False
With Sheets("Sheet1")
lastrow = .Cells(.Cells.Rows.Count, "B").End(xlUp).Row
.Cells(.Cells.Rows.Count, "B").End(xlUp).Offset(1, 0) = "Total"
.Cells(.Cells.Rows.Count, "B").End(xlUp).Offset(1, 0) = "Group Total"

For i = 1 To 7
.Cells(lastrow + 1, i + 2).FormulaR1C1 = "=SUM(R5C:R[-1]C)"
.Cells(lastrow + 1, i + 2).NumberFormat = "[\$\$-409]#,##0.00"
Next i

Set rng = Range(.Cells(5, "B"), .Cells(lastrow, "B"))

For Each celle In rng
On Error Resume Next
Next celle

For i = 1 To coll.Count
.Cells(lastrow + 2 + i, "B") = --coll(i)
Next i

For i = 1 To coll.Count
For n = 3 To 9
.Cells(lastrow + 2 + i, n).FormulaR1C1 = "=SUMIF(R5C2:R22C2,RC2,R5C:R22C)"
.Cells(lastrow + 2 + i, n).NumberFormat = "[\$\$-409]#,##0.00"
Next n
Next i

For n = 3 To 9
.Cells(lastrow + 2 + coll.Count + 1, n).FormulaR1C1 = "=SUM(R[" & -coll.Count & "]C:R[-1]C)"
.Cells(lastrow + 2 + coll.Count + 1, n).NumberFormat = "[\$\$-409]#,##0.00"
Next n

End With

End Sub
``````
llawrenceg-02.xls
0

Author Closing Comment

ID: 31578684
works perfectly and I learned something as well
0

LVL 45

Expert Comment

ID: 24352530
llawrenceg - Thanks for the grade - Patrick
0

## Featured Post

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Q&A with Course Creator, Mark Lassoff, on the importance of HTML5 in the career of a modern-day developer.
When you discover the power of the R programming language, you are going to wonder how you ever lived without it! Learn why the language merits a place in your programming arsenal.
In this fourth video of the Xpdf series, we discuss and demonstrate the PDFinfo utility, which retrieves the contents of a PDF's Info Dictionary, as well as some other information, including the page count. We show how to isolate the page count in aâ€¦
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custoâ€¦
###### Suggested Courses
Course of the Month10 days, 5 hours left to enroll