Gap between Headings and Start of Output
I think I understand what you want. I modified the code to add column H. I
added a constant Const LastDrawCol = "G" so you can easily change the last
column.
Option Explicit
Option Base 1
Const LastDrawCol = "G"
Const MinSum As Integer = 21
Const MaxSum As Integer = 279
Const MinBall As Integer = 1
Const MaxBall As Integer = 49
Const TotalComb As Long = 13983816
Sub Sum()
Dim A As Integer, B As Integer, C As Integer
Dim D As Integer, E As Integer, F As Integer
Dim i As Integer
Dim CombSum() As Single
Dim RowCount As Integer
ReDim CombSum((6 * MaxBall) - 15)
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For A = MinBall To MaxBall - 5
For B = A + 1 To MaxBall - 4
For C = B + 1 To MaxBall - 3
For D = C + 1 To MaxBall - 2
For E = D + 1 To MaxBall - 1
For F = E + 1 To MaxBall
CombSum(A + B + C + D + E + F) = _
CombSum(A + B + C + D + E + F) + 1
Next F
Next E
Next D
Next C
Next B
Next A
' Setup Output Headings
Range("B2").Value = "Text"
Range("B3").Value = "Sum"
Range("C3").Value = "Combinations"
Range("D3").Value = "Percent"
' Format Output Headings
Range("B2").HorizontalAlignment = xlCenter
Range("B2").Font.FontStyle = "Bold"
Range("B2").Font.ColorIndex = 2
RowCount = 4
For i = MinSum To MaxSum
' Calculate Output
Cells(RowCount, "B").Value = i
Cells(RowCount, "C").Value = CombSum(i)
Cells(RowCount, "D").Value = 100 / TotalComb * CombSum(i)
Cells(RowCount, "H").Formula = "=Sum(Draws!B" & RowCount & _
":" & LastDrawCol & RowCount & ")"
' Format Output
Cells(RowCount, "B").HorizontalAlignment = xlLeft
Cells(RowCount, "C").NumberFormat = "##,###,##0"
Cells(RowCount, "D").NumberFormat = "##0.00"
RowCount = RowCount + 1
Next i
' Setup Totals
Cells(RowCount, "B").Value = "Totals"
Cells(RowCount, "C").Formula = _
"=Sum(C4:C" & (RowCount - 1) & ")"
Cells(RowCount, "C").Formula = Cells(RowCount, "C").Value
Cells(RowCount, "D").Formula = _
"=Sum(D4:D" & (RowCount - 1) & ")"
Cells(RowCount, "D").Formula = Cells(RowCount, "D").Value
' Format Totals
Cells(RowCount, "C").NumberFormat = "#,###,##0"
Cells(RowCount, "D").NumberFormat = "##0.00"
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
"Paul Black" wrote:
Hi Joel,
Sorry to trouble you. The code ...
Option Explicit
Option Base 1
Const MinSum As Integer = 21
Const MaxSum As Integer = 279
Const MinBall As Integer = 1
Const MaxBall As Integer = 49
Const TotalComb As Long = 13983816
Sub Sum()
Dim A As Integer, B As Integer, C As Integer, D As Integer, E As
Integer, F As Integer
Dim i As Integer
Dim CombSum() As Single
Dim RowCount As Integer
ReDim CombSum((6 * MaxBall) - 15)
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For A = MinBall To MaxBall - 5
For B = A + 1 To MaxBall - 4
For C = B + 1 To MaxBall - 3
For D = C + 1 To MaxBall - 2
For E = D + 1 To MaxBall - 1
For F = E + 1 To MaxBall
CombSum(A + B + C + D + E + F) = CombSum(A + B + C + D +
E + F) + 1
Next F
Next E
Next D
Next C
Next B
Next A
' Setup Output Headings
Range("B2").Value = "Text"
Range("B3").Value = "Sum"
Range("C3").Value = "Combinations"
Range("D3").Value = "Percent"
' Format Output Headings
Range("B2").HorizontalAlignment = xlCenter
Range("B2").Font.FontStyle = "Bold"
Range("B2").Font.ColorIndex = 2
RowCount = 4
For i = MinSum To MaxSum
' Calculate Output
Cells(RowCount, "B").Value = i
Cells(RowCount, "C").Value = CombSum(i)
Cells(RowCount, "D").Value = 100 / TotalComb * CombSum(i)
' Format Output
Cells(RowCount, "B").HorizontalAlignment = xlLeft
Cells(RowCount, "C").NumberFormat = "##,###,##0"
Cells(RowCount, "D").NumberFormat = "##0.00"
RowCount = RowCount + 1
Next i
' Setup Totals
Cells(RowCount, "B").Value = "Totals"
Cells(RowCount, "C").Formula = _
"=Sum(C4:C" & (RowCount - 1) & ")"
Cells(RowCount, "C").Formula = Cells(RowCount, "C").Value
Cells(RowCount, "D").Formula = _
"=Sum(D4:D" & (RowCount - 1) & ")"
Cells(RowCount, "D").Formula = Cells(RowCount, "D").Value
' Format Totals
Cells(RowCount, "C").NumberFormat = "#,###,##0"
Cells(RowCount, "D").NumberFormat = "##0.00"
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
.... works brilliantly, thank you.
I have a list of draws in a worksheet named "Draws". The 6 number
combinations go from cells "B4:G?". The "G?" will obviously change on
a regular basis as more draws are added.
What I would ideally like is to SUM each 6 number combination in the
sheet named "Draws". I would then like the SUM totals to go in column
"H" next to the SUM total in column "A" produced by the program above
please.
I don't know if this will need a seperate Sub or an amendment to the
one above.
Thanks in Advance.
All the Best.
Paul
On Oct 11, 1:10 pm, Joel wrote:
Your code works and is very flexible because you just have to change B4 to
another cell and all the locations change. My prefference is to avoid
.offset because it is harder to figure out where items are going. I would of
done the code below, but both are acceptable.
' Setup Distribution Categories
Range("B4").Value = "111111"
Range("B5").Value = "211110"
Range("B6").Value = "221100"
Range("B7").Value = "222000"
Range("B8").Value = "311100"
Range("B9").Value = "321000"
Range("B10").Value = "330000"
Range("B11").Value = "411000"
Range("B12").Value = "420000"
Range("B13").Value = "510000"
Range("B14").Value = "600000"
' Format Distribution Categories
Range("B4:B14").HorizontalAlignment = xlLeft
"PaulBlack" wrote:
Hi Joel,
One FINAL question, I promise.
If I wanted to physically input values into cells for example,
would ...
With Range("B4")
' Setup Distribution Categories
.Offset(0, 0).Value = "111111"
.Offset(1, 0).Value = "211110"
.Offset(2, 0).Value = "221100"
.Offset(3, 0).Value = "222000"
.Offset(4, 0).Value = "311100"
.Offset(5, 0).Value = "321000"
.Offset(6, 0).Value = "330000"
.Offset(7, 0).Value = "411000"
.Offset(8, 0).Value = "420000"
.Offset(9, 0).Value = "510000"
.Offset(10, 0).Value = "600000"
' Format Distribution Categories
.Resize(11, 1).HorizontalAlignment = xlLeft
End With
.... be the right way to do it.
Thanks in Advance.
All the Best.
Paul
On Oct 11, 12:21 wrote:
Thanks Joel,
The program now at works perfectly, thank you, but why?.
Thanks in Advance.
All the Best.
Paul
On Oct 11, 12:06 pm, Joel wrote:
change your dim to the line below and add redim.
Dim DistSum() As Single
ReDim DistSum((6 * MaxBall) - 15)
"PaulBlack" wrote:
Thanks for the re-written code Joel, it is appreciated.
One thing though, if I change the parameters ...
Const MinDist As Integer = 21
Const MaxDist As Integer = 279
Dim DistSum(279) As Single
.... to ...
Const MinDist As Integer = 50
Const MaxDist As Integer = 250
Dim DistSum(250) As Single
.... I get an error 9, subscript out of range on line ...
DistSum(A + B + C + D + E + F) = _
DistSum(A + B + C + D + E + F) + 1
This program will be used for about 25 other calculations and ONLY the
bit in between the For .. Next loop will change. The layout will be
EXACTLY the same for all of them, so I appreciate I will not have to
change much each time thanks to you.
Thanks in Advance.
All the Best.
Paul
On Oct 11, 1:18 am, Joel wrote:
I re-wrote the code to make it easier to maintain
Option Explicit
Option Base 1
Const MinDist As Integer = 21
Const MaxDist As Integer = 279
Const MinBall As Integer = 1
Const MaxBall As Integer = 49
Const TotalComb As Long = 13983816
Sub Test()
Dim A As Integer, B As Integer, C As Integer
Dim D As Integer, E As Integer, F As Integer
Dim i As Integer
Dim DistSum(279) As Double
Dim RowCount As Integer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For i = MinDist To MaxDist
DistSum(i) = 0
Next i
For A = MinBall To MaxBall - 5
For B = A + 1 To MaxBall - 4
For C = B + 1 To MaxBall - 3
For D = C + 1 To MaxBall - 2
For E = D + 1 To MaxBall - 1
For F = E + 1 To MaxBall
DistSum(A + B + C + D + E + F) = _
DistSum(A + B + C + D + E + F) + 1
Next F
Next E
Next D
Next C
Next B
Next A
' Setup Output Headings
Range("B2").Value = "Text"
Range("B3").Value = "Distribution"
Range("C3").Value = "Combinations"
Range("D3").Value = "Percent"
' Format Output Headings
Range("B2").HorizontalAlignment = xlCenter
Range("B2").Font.FontStyle = "Bold"
Range("B2").Font.ColorIndex = 2
RowCount = 4
For i = MinDist To MaxDist
' Calculate Output
Cells(RowCount, "B").Value = i
Cells(RowCount, "C").Value = DistSum(i)
Cells(RowCount, "D").Value = 100 / TotalComb * DistSum(i)
' Format Output
Cells(RowCount, "C").NumberFormat = "##,###,##0"
Cells(RowCount, "D").NumberFormat = "##0.00"
RowCount = RowCount + 1
Next i
' Setup Totals
Cells(RowCount, "B").Value = "Totals"
Cells(RowCount, "C").Formula = _
"=Sum(C4:C" & (RowCount - 1) & ")"
Cells(RowCount, "C").Formula = Cells(RowCount, "C").Value
Cells(RowCount, "D").Formula = _
"=Sum(D4:D" & (RowCount - 1) & ")"
Cells(RowCount, "D").Formula = Cells(RowCount, "D").Value
' Format Totals
Cells(RowCount, "C").NumberFormat = "#,###,##0"
Cells(RowCount, "C").NumberFormat = "##0.00"
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
"PaulBlack" wrote:
Hi Joel,
My original code in my first post works OK except it starts the output
in the wrong place. It should start with 21 directly after the titles
Distribution, Combinations & Percent and continue down until it
reaches 279. Then it should produce the totals for combinations and
percent directly under that.
How would you write the code to do exactly what I have done. Would you
NOT use the .Offset(i + 1, 0) etc at all?.
I am new to VBA so my programming is not the best.
I used the Activecell.Offset because there is a lot of formatting in
the original and this is the only way I know how to do it.
Thanks in Advance.
All the Best.
Paul
On Oct 10, 5:05 pm, Joel wrote:
Paul: I want to make sure I solvig the right problem. Be patient with me, I
don't want to make any wrong assuptions. Please answer these questions. I
don't like using active cell just for the reason we are havving here. my
|