• Status: Solved
• Priority: Medium
• Security: Public
• Views: 365

VBA Code to Total Columns by Groups

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
llawrenceg
• 5
• 4
• 4
• +1
1 Solution

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

Commented:
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

Commented:
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 Commented:
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 Commented:
The main issue is that the code needs to determine the number of groups and run alog side some other coding
0

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

jppinto

Q24386398.xls
0

Commented:
That is precisely what my code does.

It auto filters the unique values from your data.
0

Commented:
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 Commented:
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

Commented:
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 Commented:
The "Total" and "Group Total " Labels need to be addd to the Column as the number of items in the column is vaiiable
0

Commented:
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 Commented:
works perfectly and I learned something as well
0

Commented:
llawrenceg - Thanks for the grade - Patrick
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.