Well, I have tried Select Case and incorporating the criteria underneath the For A ... For F but with no joy.
Below is the latest version of the code which I think will work when the criteria is added.
Any help will be greatly appreciated.
[vba]Option Explicit
Option Base 1
Private HalfDecade(6) As Long
Private Counts(10) As Long
Private Map(10) As Long
Sub Half_Decade()
' I want this to add all the distributions of numbers and the output them
' in the required distributions.
Dim A As Integer, B As Integer, C As Integer, D As Integer, E As Integer, F As Integer ' Ball Number
Dim n As Long
Dim Total As Long
With Application
.ScreenUpdating = False: .Calculation = xlCalculationManual: .DisplayAlerts = False
End With
Map(1) = 21111
Map(2) = 22110
Map(3) = 22200
Map(4) = 31110
Map(5) = 32100
Map(6) = 33000
Map(7) = 41100
Map(8) = 42000
Map(9) = 42000
Map(10) = 51000
For n = 1 To 10
Counts(n) = 0
Next n
For A = 1 To 19
For B = A + 1 To 20
For C = B + 1 To 21
For D = C + 1 To 22
For E = D + 1 To 23
For F = E + 1 To 24
'Code to calculate HalfDecade(n)...
' >= 1 And <= 5
' >= 6 And <= 10
' >= 11 And <= 15
' >= 16 And <= 20
' >= 21 And <= 24
'... for A, B, C, D, E & F
UpdateCounts
Next F
Next E
Next D
Next C
Next B
Next A
Range("A1").Select
For n = 1 To 10
Total = Total + Counts(n)
ActiveCell.Offset(0, 0).Value = Map(n)
ActiveCell.Offset(0, 1).Value = Format(Counts(n), "#,0")
ActiveCell.Offset(1, 1).Value = Format(Total, "#,0")
ActiveCell.Offset(1, 0).Select
Next n
With Application
.DisplayAlerts = True: .Calculation = xlCalculationAutomatic: .ScreenUpdating = True
End With
End Sub
Private Sub UpdateCounts()
Dim Cnt(0 To 10) As Long
Dim n As Long
Dim j As Long
Dim max As Long
Dim pattern As Long
For n = 1 To 6
Cnt(HalfDecade(n)) = Cnt(HalfDecade(n)) + 1
Next n
For n = 1 To 6
max = 0
For j = 0 To 4
If Cnt(j) > Cnt(max) Then
max = j
End If
Next j
pattern = pattern * 10 + Cnt(max)
Cnt(max) = 0
Next n
For n = 1 To UBound(Map)
If Map(n) = pattern Then
Counts(n) = Counts(n) + 1
Exit For
End If
Next n
End Sub[/vba]
Thanks in advance.
Kind regards,
PAB