Brilliant Tom, Thanks Very Much.
Just One thing, I Included Option Explicit and Ran the Macro, I got an
ERROR on Line :-
Application.SumIf(rng3.Offset(*0, -1), "" & l, rng3)
I Deleted the Minus Before the Zero and All Worked Great. Is there a
Specific Reason that the Minus Needs to be there Please.
Also, I Included Lbound & Ubound so that I don't have to Physically
Change the Values ( Only in the nType Array ).
Option Explicit
Option Base 1
Sub Test()
Dim A As Integer
Dim B As Integer
Dim C As Integer
Dim D As Integer
Dim E As Integer
Dim F As Integer
Dim nType(1 To 203) As Long
Dim rng As Range
Dim s As Long, s1 As Long
Dim grpsize As Long
Dim rng1 As Range, rng2 As Range
Dim rng3 As Range, rng4 As Range
Dim rng5 As Range, rng6 As Range
Dim i As Long, j As Long, k As Long
Dim l As Long
'
' set group size
'
grpsize = 20
Application.ScreenUpdating = False
Sheets("Results1").Select
Range("B3").Select
Columns("B:F").ClearContents
For i = LBound(nType) To UBound(nType)
nType(i) = 0
Next i
For A = 1 To 33 - 5
For B = A + 1 To 33 - 4
For C = B + 1 To 33 - 3
For D = C + 1 To 33 - 2
For E = D + 1 To 33 - 1
For F = E + 1 To 33
s1 = A + B + C + D + E + F
nType(s1) = nType(s1) + 1
Next F
Next E
Next D
Next C
Next B
Next A
Set rng1 = ActiveCell.Offset(1, 2)
For i = LBound(nType) To UBound(nType)
ActiveCell.Offset(1, 0).Value = "Total for"
ActiveCell.Offset(1, 1).Value = i
ActiveCell.Offset(1, 2).NumberFormat = "#,##0"
ActiveCell.Offset(1, 2).Value = nType(i)
ActiveCell.Offset(1, 0).Select
Next i
Set rng2 = ActiveCell.Offset(0, 2)
ActiveCell.Offset(1, 0).Value = "Grand Total"
Set rng3 = Range(rng1, rng2)
Set rng = ActiveCell.Offset(1, 2)
ActiveCell.Offset(1, 2).NumberFormat = "#,##0"
rng.Value = Application.Sum(rng3)
ActiveCell.Offset(2, 0).Select
k = Application.RoundUp(rng3.Count / grpsize, 0)
j = LBound(nType)
Set rng4 = rng(2 + 1, 1)
Set rng5 = rng(2 + k, 1)
Set rng6 = Range(rng4, rng5)
For i = 1 To k
l = j + grpsize - 1
If l rng2.Offset(0, -1).Value Then
l = rng2.Offset(0, -1).Value
End If
rng(2 + i, -1).Value = "Total for"
rng(2 + i, 0).Value = j & " to " & l
rng(2 + i, 1).Value = Application.SumIf( _
rng3.Offset(0, -1), "=" & j, rng3) - _
Application.SumIf(rng3.Offset(0, -1), _
"" & l, rng3)
rng(2 + i, 1).NumberFormat = "#,##0"
j = l + 1
Next
rng5.Offset(2, -2).Value = "Grand Total"
rng5.Offset(2, 0).NumberFormat = "#,##0"
rng5.Offset(2, 0).Value = Application.Sum(rng6)
Application.ScreenUpdating = True
End Sub
Thanks Again.
All the Best.
Paul
Help with Totalling Groups Please
From: Tom Ogilvy
Option Base 1
Sub Test()
Dim A As Integer
Dim B As Integer
Dim C As Integer
Dim D As Integer
Dim E As Integer
Dim F As Integer
Dim nType(203) As Long
Dim nTypeTotal As Long
Dim rng As Range
Dim s As Long, s1 As Long
Dim grpsize As Long
Dim rng1 As Range, rng2 As Range
Dim rng3 As Range, rng4 As Range
Dim rng5 As Range, rng6 As Range
Dim i As Long, j As Long, k As Long
Dim l As Long
'
' set group size
'
grpsize = 20
Application.ScreenUpdating = False
Sheets("Results").Select
Range("B3").Select
Columns("B:F").ClearContents
For i = 103 To 203
nType(i) = 0
Next i
For A = 1 To 33 - 5
For B = A + 1 To 33 - 4
For C = B + 1 To 33 - 3
For D = C + 1 To 33 - 2
For E = D + 1 To 33 - 1
For F = E + 1 To 33
s1 = A + B + C + D + E + F
nType(s1) = nType(s1) + 1
Next F
Next E
Next D
Next C
Next B
Next A
nTypeTotal = ActiveCell.Row
Set rng1 = ActiveCell.Offset(1, 2)
For i = 103 To 203
ActiveCell.Offset(1, 0).Value = "Total for"
ActiveCell.Offset(1, 1).Value = i
ActiveCell.Offset(1, 2).Value = nType(i)
ActiveCell.Offset(1, 0).Select
Next i
Set rng2 = ActiveCell.Offset(0, 2)
ActiveCell.Offset(1, 0).Value = "Grand Total"
Set rng3 = Range(rng1, rng2)
Set rng = ActiveCell.Offset(1, 2)
rng.Value = Application.Sum(rng3)
ActiveCell.Offset(2, 0).Select
k = Application.RoundUp(rng3.Count / grpsize, 0)
j = 103
Set rng4 = rng(2 + 1, 1)
Set rng5 = rng(2 + k, 1)
Set rng6 = Range(rng4, rng5)
For i = 1 To k
l = j + grpsize - 1
If l rng2.Offset(0, -1).Value Then
l = rng2.Offset(0, -1).Value
End If
rng(2 + i, -1).Value = "Total for"
rng(2 + i, 0).Value = j & " to " & l
rng(2 + i, 1).Value = Application.SumIf( _
rng3.Offset(0, -1), "=" & j, rng3) - _
Application.SumIf(rng3.Offset(0, -1), _
"" & l, rng3)
rng(2 + i, 1).NumberFormat = "#,##0"
j = l + 1
Next
rng5.Offset(2, -2).Value = "Grand Total"
rng5.Offset(2, 0).NumberFormat = "#,##0"
rng5.Offset(2, 0).Value = Application.Sum(rng6)
Application.ScreenUpdating = True
End Sub
--
Regards,
Tom Ogilvy
*** Sent via Developersdex
http://www.developersdex.com ***