PAB

09-30-2012, 07:25 AM

Good afternoon,

I am trying to calculate the number of combinations for set distributions.

I want the code to cycle through the MinBall to MaxBall and count the combintions that have the distributions as set in the code.

I am trying to use Select Case to do this but can't seem to get it to work.

I am probably approaching this completely wrong!

Option Explicit

Option Base 1

Const MinDist As Integer = 1

Const MaxDist As Integer = 6

Const MinBall As Integer = 1

Const MaxBall As Integer = 24

Const TotalComb As Long = 134596

Sub Distribution_3()

Dim A As Integer, B As Integer, C As Integer, D As Integer, E As Integer, F As Integer

Dim i As Integer

Dim j As Integer

Dim Dist As Double

Dim DistSum(7) As Double

With Application

.ScreenUpdating = False: .Calculation = xlCalculationManual: .DisplayAlerts = False

End With

With Sheets("Distribution").Select

With ActiveSheet

Cells.Select

Selection.Delete Shift:=xlUp

Selection.ColumnWidth = 3

Range("B2").Select

End With

' Reset to ZERO

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

Select Case A

Case 1, 2, 3, 4, 5

Dist = 10000

End Select

Select Case B

Case 6, 7, 8, 9, 10

Dist = Dist + 1000

End Select

Select Case C

Case 11, 12, 13, 14, 15

Dist = Dist + 100

End Select

Select Case D

Case 16, 17, 18, 19, 20

Dist = Dist + 10

End Select

Select Case E

Case 21, 22, 23, 24

Dist = Dist + 1

End Select

If Dist = 51 Then DistSum(1) = DistSum(1) + 1

If Dist = 411 Then DistSum(2) = DistSum(2) + 1

If Dist = 42 Then DistSum(3) = DistSum(3) + 1

If Dist = 33 Then DistSum(4) = DistSum(4) + 1

If Dist = 321 Then DistSum(5) = DistSum(5) + 1

If Dist = 222 Then DistSum(6) = DistSum(6) + 1

' Reset [Dist] to ZERO after a Combination (A B C D E F) has been Processed

Dist = 0

Next F

Next E

Next D

Next C

Next B

Next A

With ActiveCell

For i = MinDist To MaxDist

' Calculate Output

.Offset(i + 1, 1).Value = DistSum(i)

.Offset(i + 1, 2).Value = 100 / TotalComb * DistSum(i)

.Offset(i + 1, 3).Value = TotalComb / DistSum(i)

Next i

' Setup Totals

.Offset(i + 2, 1).FormulaR1C1 = "=Sum(R4C3:R[-1]C)"

.Offset(i + 2, 1).Formula = .Offset(i + 2, 1).Value

.Offset(i + 2, 2).FormulaR1C1 = "=Sum(R4C4:R[-1]C)"

.Offset(i + 2, 2).Formula = .Offset(i + 2, 2).Value

End With

End With

With Application

.DisplayAlerts = True: .Calculation = xlCalculationAutomatic: .ScreenUpdating = True

End With

End Sub

Any help will be appreciated.

Thanks in advance.

PAB

I am trying to calculate the number of combinations for set distributions.

I want the code to cycle through the MinBall to MaxBall and count the combintions that have the distributions as set in the code.

I am trying to use Select Case to do this but can't seem to get it to work.

I am probably approaching this completely wrong!

Option Explicit

Option Base 1

Const MinDist As Integer = 1

Const MaxDist As Integer = 6

Const MinBall As Integer = 1

Const MaxBall As Integer = 24

Const TotalComb As Long = 134596

Sub Distribution_3()

Dim A As Integer, B As Integer, C As Integer, D As Integer, E As Integer, F As Integer

Dim i As Integer

Dim j As Integer

Dim Dist As Double

Dim DistSum(7) As Double

With Application

.ScreenUpdating = False: .Calculation = xlCalculationManual: .DisplayAlerts = False

End With

With Sheets("Distribution").Select

With ActiveSheet

Cells.Select

Selection.Delete Shift:=xlUp

Selection.ColumnWidth = 3

Range("B2").Select

End With

' Reset to ZERO

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

Select Case A

Case 1, 2, 3, 4, 5

Dist = 10000

End Select

Select Case B

Case 6, 7, 8, 9, 10

Dist = Dist + 1000

End Select

Select Case C

Case 11, 12, 13, 14, 15

Dist = Dist + 100

End Select

Select Case D

Case 16, 17, 18, 19, 20

Dist = Dist + 10

End Select

Select Case E

Case 21, 22, 23, 24

Dist = Dist + 1

End Select

If Dist = 51 Then DistSum(1) = DistSum(1) + 1

If Dist = 411 Then DistSum(2) = DistSum(2) + 1

If Dist = 42 Then DistSum(3) = DistSum(3) + 1

If Dist = 33 Then DistSum(4) = DistSum(4) + 1

If Dist = 321 Then DistSum(5) = DistSum(5) + 1

If Dist = 222 Then DistSum(6) = DistSum(6) + 1

' Reset [Dist] to ZERO after a Combination (A B C D E F) has been Processed

Dist = 0

Next F

Next E

Next D

Next C

Next B

Next A

With ActiveCell

For i = MinDist To MaxDist

' Calculate Output

.Offset(i + 1, 1).Value = DistSum(i)

.Offset(i + 1, 2).Value = 100 / TotalComb * DistSum(i)

.Offset(i + 1, 3).Value = TotalComb / DistSum(i)

Next i

' Setup Totals

.Offset(i + 2, 1).FormulaR1C1 = "=Sum(R4C3:R[-1]C)"

.Offset(i + 2, 1).Formula = .Offset(i + 2, 1).Value

.Offset(i + 2, 2).FormulaR1C1 = "=Sum(R4C4:R[-1]C)"

.Offset(i + 2, 2).Formula = .Offset(i + 2, 2).Value

End With

End With

With Application

.DisplayAlerts = True: .Calculation = xlCalculationAutomatic: .ScreenUpdating = True

End With

End Sub

Any help will be appreciated.

Thanks in advance.

PAB