Solved

VBA Code to Total Columns by Groups

Posted on 2009-05-06
14
355 Views
Last Modified: 2013-11-10
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
Comment
Question by:llawrenceg
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 5
  • 4
  • 4
  • +1
14 Comments
 
LVL 19

Expert Comment

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

Expert Comment

by:david251
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
        MsgBox "Please select your data. Aborting", vbOKOnly
        Exit Sub
    End If
    
    Dim rngDest As Range
    
    Set rngDest = Cells(rng.Row + rng.Rows.Count + 4, rng.Column)
    rngDest.ClearContents
    rng.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=rngDest, Unique:=True
    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

Open in new window

0
 
LVL 45

Expert Comment

by:patrickab
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
Get MySQL database support online, now!

At Percona’s web store you can order your MySQL database support needs in minutes. No hassles, no fuss, just pick and click. Pay online with a credit card.

 

Author Comment

by:llawrenceg
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

Open in new window

Book2.xls
0
 

Author Comment

by:llawrenceg
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

by:jppinto
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

by:david251
ID: 24320022
That is precisely what my code does.

It auto filters the unique values from your data.
0
 
LVL 19

Expert Comment

by:david251
ID: 24320075
Try this:
Sub subFilterUniqueSubtotal()
    
    Dim intColumnSumOffset As Integer
'Enter an offset for column to sum
    intColumnSumOffset = 1
 
    Dim rng As Range
    Set rng = Range("AD5:AD22")
    
    Dim rngDest As Range
    
    Set rngDest = Cells(rng.Row + rng.Rows.Count + 2, rng.Column)
    rngDest.ClearContents
    rng.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=rngDest, Unique:=True
 
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

Open in new window

0
 

Author Comment

by:llawrenceg
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

by:patrickab
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
        coll.Add CStr(celle), CStr(celle)
    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

Open in new window

llawrenceg-01.xls
0
 

Author Comment

by:llawrenceg
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

by:
patrickab earned 500 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
        coll.Add CStr(celle), CStr(celle)
    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

Open in new window

llawrenceg-02.xls
0
 

Author Closing Comment

by:llawrenceg
ID: 31578684
works perfectly and I learned something as well
0
 
LVL 45

Expert Comment

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

Featured Post

Back Up Your Microsoft Windows Server®

Back up all your Microsoft Windows Server – on-premises, in remote locations, in private and hybrid clouds. Your entire Windows Server will be backed up in one easy step with patented, block-level disk imaging. We achieve RTOs (recovery time objectives) as low as 15 seconds.

Question has a verified solution.

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

In this post we will learn different types of Android Layout and some basics of an Android App.
The SignAloud Glove is capable of translating American Sign Language signs into text and audio.
This Micro Tutorial demonstrates using Microsoft Excel pivot tables, how to reverse engineer competitors' marketing strategies through backlinks.
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.

630 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question