Sorry for another Thread..Count and Sum Problem

[mbarnett]

I posted an early thread, but I think i need to reword the problem. I created code to read in info based on a criteria and print into another sheet. I can't figure out how to put a sum and a count for cretain parts of my criteria. I can't use subtotal wizard because it does not allow both. So -

Criteria Age Amt
A 25 100
A 50 75
Total 2 175
B 35 80
B 60 20
Total 2 100

Currently my macro does not do totals count for age and sum for amount. Is there away to implement it in the code based on my criteria field to count Age and Sum up Amt for each criteria.

Again your Help is Greatly appreciated.

Mark

 

[Zathras]

Here are a couple of user-defined functions you can use:
[blue]

Option Explicit

Function GroupSum(ARange As Range)

[green]

' ARange identifies a range of cells with "Criteria" in
' the first column.
' Rightmost column must contain data to be summed.
' Similar to SUMIF but summing starts at bottom and works up,
' stopping when "criteria" changes.
' Example:   =GroupSum($A$1:C9)

[/color]

Dim sCriterion As String
Dim nColumn As Integer
Dim r As Range
  nColumn = ARange.Columns.Count
  Set r = ARange.Cells(ARange.Rows.Count, 1)
  GroupSum = 0
  If r.Row > 1 Then
    sCriterion = r.Text
    While (r.Row > 1) And (sCriterion = r.Text)
      GroupSum = GroupSum + r.Offset(0, nColumn - 1).Value
      Set r = r.Offset(-1, 0)
    Wend
  End If
End Function

Function GroupCount(ARange As Range)

[green]

' ARange identifies a range of cells with "Criteria" in
' the first column.
' Rightmost column must contain data to be counted.
' Similar to COUNTIF but counting starts at bottom and works up,
' stopping when "criteria" changes.
' Example:   =GroupCount($A$1:B9)

[/color]

Dim sCriterion As String
Dim nColumn As Integer
Dim r As Range
  nColumn = ARange.Columns.Count
  Set r = ARange.Cells(ARange.Rows.Count, 1)
  GroupCount = 0
  If r.Row > 1 Then
    sCriterion = r.Text
    While (r.Row > 1) And (sCriterion = r.Text)
      If Not IsEmpty(r.Offset(0, nColumn - 1)) Then GroupCount = GroupCount + 1
      Set r = r.Offset(-1, 0)
    Wend
  End If
End Function

[/color]
Assuming your example above is in cells A1:C7, then these formulas will give you your results:
[blue]

B4: =GroupCount($A$1:B3)
C4: =GroupSum($A$1:C3)
  (copy to B7 and C7)

[/color]

 

[mbarnett]

Hi Zathras,
Thanks for your reply. I'm pretty new to VBA. How can I incorporate the above functions in my sub routine when it prints the data. I've included the code below. -

Dim i As Integer

Sheets("Sheet1&quot.Select

For i = 1 To UBound(sec)
Cells(i + 1, 1).Value = sec(i).critera
Cells(i + 1, 2).Value = sec(i).age
Cells(i + 1, 3).Value = sec(i).amt

Next i
End Sub

 

[mbarnett]

Zathras,
Forgive me ignorance...Is there a way to automatically do it in the sub routine. I not really sure how to pass functions into subs

Thanks Again for your Help.


Mark

 

[Zathras]

Since I don't have your file and record structure to work with, I had to improvise, but you should be able to get the idea from this code:
[blue]

Sub test()
Dim testdata(4, 3) As Variant
  testdata(1, 1) = "A"
  testdata(1, 2) = 25
  testdata(1, 3) = 100
  testdata(2, 1) = "A"
  testdata(2, 2) = 50
  testdata(2, 3) = 75
  testdata(3, 1) = "B"
  testdata(3, 2) = 35
  testdata(3, 3) = 80
  testdata(4, 1) = "B"
  testdata(4, 2) = 60
  testdata(4, 3) = 20
  PutDataInSheet testdata
End Sub

Sub PutDataInSheet(sec As Variant)
Const CRITERIA = 1
Const AGE = 2
Const AMT = 3
Dim i As Long
Dim r As Long
    
    Cells(1, 1) = "Criteria"
    Cells(1, 2) = "Age"
    Cells(1, 3) = "Amt"
    r = 1
    For i = 1 To UBound(sec)
        r = r + 1
        Cells(r, 1).Value = sec(i, CRITERIA)
        Cells(r, 2).Value = sec(i, AGE)
        Cells(r, 3).Value = sec(i, AMT)
        
        If i = UBound(sec) Then
          r = r + 1
          Cells(r, 1).Value = "Total"
          Cells(r, 2).FormulaR1C1 = "=GroupCount(R1C1:R[-1]C)"
          Cells(r, 3).FormulaR1C1 = "=GroupSum(R1C1:R[-1]C)"
        Else
          If sec(i + 1, CRITERIA) <> sec(i, CRITERIA) Then
            r = r + 1
            Cells(r, 1).Value = &quot;Total&quot;
            Cells(r, 2).FormulaR1C1 = &quot;=GroupCount(R1C1:R[-1]C)&quot;
            Cells(r, 3).FormulaR1C1 = &quot;=GroupSum(R1C1:R[-1]C)&quot;
          End If
        End If
      Next i

End Sub

[/color]
Run the "test" macro with a blank Sheet1 and it should reproduce the test data you gave in a previous post.

BTW, with just a little more work, you could keep track of the first and last row of each "group" and then you could use the SUBTOTAL function (2=count, 9=sum) to get the same result.

 

[mbarnett]

Thanks Zathras for your help...

I keep getting a complie mitmatch error for <> in the code. I implemented your code into mine.. I think I may have screwed it up.

Sub print_results2(sec() As Nostro)
Const Criteria = 1
Const Age = 2
Const amt = 5
Dim i As Long
Dim r As Long


Sheets(&quot;Sheet3&quot.Select
r = 2
For i = 1 To UBound(sec)
Cells(r, 1).Value = sec(i, Criteria).critera
Cells(r, 2).Value = sec(i, Age).Age
Cells(r, 3).Value = sec(i).new_spn
Cells(r, 4).Value = sec(i).vdate
Cells(r, 5).Value = sec(i, amt).ccy__amount
Cells(r, 6).Value = sec(i).ccy
Cells(r, 7).Value = sec(i).nm_type
Cells(r, 8).Value = sec(i).sett_type
If i = UBound(sec) Then
r = r + 1
Cells(r, 1).Value = &quot;Total&quot;
Cells(r, 2).FormulaR1C1 = &quot;=GroupCount(R1C1:R[-1]C)&quot;
Cells(r, 5).FormulaR1C1 = &quot;=GroupSum(R1C1:R[-1]C)&quot;
Else
If sec(i + 1, Criteria) <> sec(i, Criteria) Then
r = r + 1
Cells(r, 1).Value = &quot;Total&quot;
Cells(r, 2).FormulaR1C1 = &quot;=GroupCount(R1C1:R[-1]C)&quot;
Cells(r, 5).FormulaR1C1 = &quot;=GroupSum(R1C1:R[-1]C)&quot;
End If
End If
Next i
End Sub

Thanks again for your help.

 

[Zathras]

You have to change references like these:

        Cells(r, 1).Value = sec(i, Criteria).critera
        Cells(r, 2).Value = sec(i, Age).Age

back to the original style like these:

        Cells(r, 1).Value = sec(i).critera
        Cells(r, 2).Value = sec(i).Age

wherever they are found. (More than just these two lines.)

Also you must increment r with every loop, not just at the total break lines. (Put it back the way I had it):
[blue]

:
:
  r = 1
  For i = 1 To UBound(sec)
    r = r + 1
:
:

[/color]
Since you will end up with more rows of data than you have elements in the array (because of the total lines), you need two separate counters: r == row, i == index

 

[mbarnett]

Thanks... I will give it a shot.