Solved

VBA Code to Total Columns by Groups

Posted on 2009-05-06
14
332 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
  • 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
 

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
Find Ransomware Secrets With All-Source Analysis

Ransomware has become a major concern for organizations; its prevalence has grown due to past successes achieved by threat actors. While each ransomware variant is different, we’ve seen some common tactics and trends used among the authors of the malware.

 
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

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

As with any other System Center product, the installation for the Authoring Tool can be quite a pain sometimes. This article serves to help you avoid making these mistakes and hopefully save you a ton of time on troubleshooting :)  Step 1: Make sur…
Technology opened people to different means of presenting information, but PowerPoint remains to be above competition. Know why PPT still works today.
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.
This Micro Tutorial will demonstrate how to create pivot charts out of a data set. I also added a drop-down menu which allows to choose from different categories in the data set and the chart will automatically update.

760 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

Need Help in Real-Time?

Connect with top rated Experts

19 Experts available now in Live!

Get 1:1 Help Now