Can this Code be Condensed

P

Paul Black

Hi everyone,

Is there any way that the code below can be condensed or shortened
please
It cycles through six number combinations and counts the total of ALL
the digits in each combination. So, combination 10,11,12,13,14,15 will
= 1+0+1+1+1+2+1+3+1+4+1+5 = 21.
The total of ALL the digits range from 11 to 70.
Her is the code :-

Option Explicit
Option Base 1

Sub Sum_Of_Digits()
Dim Start As Double
Start = Timer
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 i As Integer
Dim nMinA As Integer
Dim nMaxF As Integer
Dim nType(70) As Double

Application.ScreenUpdating = False
Sheets("Results").Select
Range("B4").Select

nMinA = 1
nMaxF = 49

For i = 11 To 70
nType(i) = 0
Next i

For A = nMinA To nMaxF - 5
For B = A + 1 To nMaxF - 4
For C = B + 1 To nMaxF - 3
For D = C + 1 To nMaxF - 2
For E = D + 1 To nMaxF - 1
For F = E + 1 To nMaxF

If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 1 Then nType(1) = nType(1)
+ 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 2 Then nType(2) = nType(2)
+ 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 3 Then nType(3) = nType(3)
+ 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 4 Then nType(4) = nType(4)
+ 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 5 Then nType(5) = nType(5)
+ 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 6 Then nType(6) = nType(6)
+ 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 7 Then nType(7) = nType(7)
+ 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 8 Then nType(8) = nType(8)
+ 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 9 Then nType(9) = nType(9)
+ 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 10 Then nType(10) =
nType(10) + 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 11 Then nType(11) =
nType(11) + 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 12 Then nType(12) =
nType(12) + 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 13 Then nType(13) =
nType(13) + 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 14 Then nType(14) =
nType(14) + 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 15 Then nType(15) =
nType(15) + 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 16 Then nType(16) =
nType(16) + 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 17 Then nType(17) =
nType(17) + 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 18 Then nType(18) =
nType(18) + 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 19 Then nType(19) =
nType(19) + 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 20 Then nType(20) =
nType(20) + 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 21 Then nType(21) =
nType(21) + 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 22 Then nType(22) =
nType(22) + 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 23 Then nType(23) =
nType(23) + 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 24 Then nType(24) =
nType(24) + 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 25 Then nType(25) =
nType(25) + 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 26 Then nType(26) =
nType(26) + 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 27 Then nType(27) =
nType(27) + 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 28 Then nType(28) =
nType(28) + 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 29 Then nType(29) =
nType(29) + 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 30 Then nType(30) =
nType(30) + 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 31 Then nType(31) =
nType(31) + 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 32 Then nType(32) =
nType(32) + 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 33 Then nType(33) =
nType(33) + 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 34 Then nType(34) =
nType(34) + 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 35 Then nType(35) =
nType(35) + 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 36 Then nType(36) =
nType(36) + 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 37 Then nType(37) =
nType(37) + 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 38 Then nType(38) =
nType(38) + 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 39 Then nType(39) =
nType(39) + 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 40 Then nType(40) =
nType(40) + 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 41 Then nType(41) =
nType(41) + 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 42 Then nType(42) =
nType(42) + 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 43 Then nType(43) =
nType(43) + 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 44 Then nType(44) =
nType(44) + 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 45 Then nType(45) =
nType(45) + 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 46 Then nType(46) =
nType(46) + 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 47 Then nType(47) =
nType(47) + 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 48 Then nType(48) =
nType(48) + 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 49 Then nType(49) =
nType(49) + 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 50 Then nType(50) =
nType(50) + 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 51 Then nType(51) =
nType(51) + 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 52 Then nType(52) =
nType(52) + 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 53 Then nType(53) =
nType(53) + 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 54 Then nType(54) =
nType(54) + 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 55 Then nType(55) =
nType(55) + 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 56 Then nType(56) =
nType(56) + 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 57 Then nType(57) =
nType(57) + 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 58 Then nType(58) =
nType(58) + 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 59 Then nType(59) =
nType(59) + 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 60 Then nType(60) =
nType(60) + 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 61 Then nType(61) =
nType(61) + 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 62 Then nType(62) =
nType(62) + 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 63 Then nType(63) =
nType(63) + 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 64 Then nType(64) =
nType(64) + 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 65 Then nType(65) =
nType(65) + 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 66 Then nType(66) =
nType(66) + 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 67 Then nType(67) =
nType(67) + 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 68 Then nType(68) =
nType(68) + 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 69 Then nType(69) =
nType(69) + 1
If A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10
+ D Mod 10 _
+ E \ 10 + E Mod 10 + F \ 10 + F Mod 10 = 70 Then nType(70) =
nType(70) + 1

Next F
Next E
Next D
Next C
Next B
Next A

For i = 11 To 70
ActiveCell.Offset(0, 0).Value = "Sum Of Digits ="
ActiveCell.Offset(0, 1).Value = i
ActiveCell.Offset(0, 2).Value = nType(i)
ActiveCell.Offset(1, 0).Select
Next i

ActiveCell.Offset(0, 0).Value = "Total Combinations Produced"
ActiveCell.Offset(0, 2).Value = nType(1) + nType(2) + nType(3) _
+ nType(4) + nType(5) + nType(6) + nType(7) + nType(8) + nType(9)
_
+ nType(10) + nType(11) + nType(12) + nType(13) + nType(14) +
nType(15) _
+ nType(16) + nType(17) + nType(18) + nType(19) + nType(20) +
nType(21) _
+ nType(22) + nType(23) + nType(24) + nType(25) + nType(26) +
nType(27) _
+ nType(28) + nType(29) + nType(30) + nType(31) + nType(32) +
nType(33) _
+ nType(34) + nType(35) + nType(36) + nType(37) + nType(38) +
nType(39) _
+ nType(40) + nType(41) + nType(42) + nType(43) + nType(44) +
nType(45) _
+ nType(46) + nType(47) + nType(48) + nType(49) + nType(50) +
nType(51) _
+ nType(52) + nType(53) + nType(54) + nType(55) + nType(56) +
nType(57) _
+ nType(58) + nType(59) + nType(60) + nType(61) + nType(62) +
nType(63) _
+ nType(64) + nType(65) + nType(66) + nType(67) + nType(68) +
nType(69) _
+ nType(70)

ActiveCell.Offset(2, 0) = "This Program Took " & _
Format(((Timer - Start) / 24 / 60 / 60), "hh:mm:ss") & " To
Process"

Range("B68").Select
Application.ScreenUpdating = True
End Sub

Thanks in Advance.
All the Best.
Paul
 
J

Joel

Here we go again. Is it better to have arrays, functtions, or just put the
code In-line. If A,b,C,d,E,F werre an array the code can be simplified. I
went back to our previous posting and stole some of my old code. Can you
steal from yourself?


Option Explicit
Option Base 1
Sub Sum_Of_Digits()
Dim Start As Double
Start = Timer
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 i As Integer
Dim nMinA As Integer
Dim nMaxF As Integer
Dim nType(70) As Double
Dim number(6) As Integer
Dim sum As Long
Application.ScreenUpdating = False
Sheets("Results").Select
Range("B4").Select

nMinA = 1
nMaxF = 49

For i = 11 To 70
nType(i) = 0
Next i


For A = nMinA To nMaxF - 5
number(1) = A
For B = A + 1 To nMaxF - 4
number(2) = B
For C = B + 1 To nMaxF - 3
number(3) = C
For D = C + 1 To nMaxF - 2
number(4) = D
For E = D + 1 To nMaxF - 1
number(5) = E
For F = E + 1 To nMaxF
number(6) = F

sum = 0
For i = 1 To 6
sum = sum + Int(number(i) / 10) + (number(i) Mod 10)
Next i

nType(sum) = nType(sum) + 1

Next F
Next E
Next D
Next C
Next B
Next A

For i = 11 To 70
ActiveCell.Offset(0, 0).Value = "Sum Of Digits ="
ActiveCell.Offset(0, 1).Value = i
ActiveCell.Offset(0, 2).Value = nType(i)
ActiveCell.Offset(1, 0).Select
Next i

ActiveCell.Offset(0, 0).Value = "Total Combinations Produced"
sum = 0
For i = 1 To 70
sum = sum + nType(i)
Next i
ActiveCell.Offset(0, 2).Value = sum

ActiveCell.Offset(2, 0) = "This Program Took " & _
Format(((Timer - Start) / 24 / 60 / 60), "hh:mm:ss") & " To Process "

Range("B68").Select
Application.ScreenUpdating = True
End Sub
 
J

Joel

This code runs faster than my las

Option Explicit
Option Base 1
Sub Sum_Of_Digits()
Dim Start As Double
Start = Timer
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 i As Integer
Dim nMinA As Integer
Dim nMaxF As Integer
Dim nType(70) As Double
Dim sum As Long
Application.ScreenUpdating = False
Sheets("Results").Select
Range("B4").Select

nMinA = 1
nMaxF = 49

For i = 11 To 70
nType(i) = 0
Next i


For A = nMinA To nMaxF - 5
For B = A + 1 To nMaxF - 4
For C = B + 1 To nMaxF - 3
For D = C + 1 To nMaxF - 2
For E = D + 1 To nMaxF - 1
For F = E + 1 To nMaxF

sum = A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10 _
+ D Mod 10 + E \ 10 + E Mod 10 + F \ 10 + F Mod 10

nType(sum) = nType(sum) + 1

Next F
Next E
Next D
Next C
Next B
Next A

For i = 11 To 70
ActiveCell.Offset(0, 0).Value = "Sum Of Digits ="
ActiveCell.Offset(0, 1).Value = i
ActiveCell.Offset(0, 2).Value = nType(i)
ActiveCell.Offset(1, 0).Select
Next i

ActiveCell.Offset(0, 0).Value = "Total Combinations Produced"
sum = 0
For i = 1 To 70
sum = sum + nType(i)
Next i
ActiveCell.Offset(0, 2).Value = sum

ActiveCell.Offset(2, 0) = "This Program Took " & _
Format(((Timer - Start) / 24 / 60 / 60), "hh:mm:ss") & " To Process "

Range("B68").Select
Application.ScreenUpdating = True
End Sub
t posting.
 
D

Dana DeLouis

Another option would be similar to previous code.
The code is figuring out the sum of digits over and over.
Try doing it once per each of the 49 digits.

Dim n(1 To 49) As Long

' Do Once Here
For R = 1 To 49
n(R) = 'Sum of digits
Next R

Now...just add. :>)
a+b+c...ect
 
J

Joel

Dana: Isn't what you are suggesting the same thing I posted in my code?

sum = A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D \ 10 _
+ D Mod 10 + E \ 10 + E Mod 10 + F \ 10 + F Mod 10

nType(sum) = nType(sum) + 1
 
P

Paul Black

Hi Joel & Dana, thanks for the replies.

Joel.
Your second code does indeed run faster than the first and produces
the correct results thank you.

Dana,
I have done as you suggested but can't get the code to work. This is
what I have :-

Option Explicit
Option Base 1

Sub Sum_Of__Digits()
Dim A As Long, B As Long, C As Long
Dim D As Long, E As Long, F As Long
Dim R As Long
Dim nMinA As Integer
Dim nMaxF As Integer
Dim S As String
Dim StartTime As Double
Dim Total As Long
Dim n(1 To 49) As Long
Dim SumOfDigits(11 To 70) As Long

StartTime = Timer

nMinA = 1
nMaxF = 49

For R = 1 To 49
n(R) = A \ 10 + A Mod 10 + B \ 10 + B Mod 10 + C \ 10 + C Mod 10 + D
\ 10 _
+ D Mod 10 + E \ 10 + E Mod 10 + F \ 10 + F Mod 10
Next R

For A = nMinA To nMaxF - 5
For B = A + 1 To nMaxF - 4
For C = B + 1 To nMaxF - 3
For D = C + 1 To nMaxF - 2
For E = D + 1 To nMaxF - 1
For F = E + 1 To nMaxF
R = n(A) + n(B) + n(C) + n(D) + n(E) + n(F)
SumOfDigits(R) = SumOfDigits(R) + 1
Next F
Next E
Next D
Next C
Next B
Next A

For R = 11 To 70
Cells(R + 1, 1) = R
Cells(R + 1, 2) = Format(SumOfDigits(R), "#,0")
Total = Total + SumOfDigits(R)
Next R

S = Format(Total, "#,0")
Cells(R + 1, 2) = S

Debug.Print Timer - StartTime

If Total = WorksheetFunction.Combin(49, 6) Then
MsgBox "Total is correct: " & S
Else
MsgBox "Error in Total: " & S
End If

End Sub

Thanks in Advance.
All the Best.
Paul
 
J

Joel

Paul: I think this is what Dana was suggesting. It runs 2x faster than my
other code.

Option Explicit
Option Base 1
Sub Sum_Of_Digits()
Dim Start As Double
Start = Timer
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 i As Integer
Dim nMinA As Integer
Dim nMaxF As Integer
Dim nType(70) As Double
Dim sum As Long
Application.ScreenUpdating = False
Sheets("Results").Select
Range("B4").Select
Dim results(49) As Long


nMinA = 1
nMaxF = 49

For i = 11 To 70
nType(i) = 0
Next i

For i = nMinA To nMaxF
results(i) = i \ 10 + i Mod 10
Next i


For A = nMinA To nMaxF - 5
For B = A + 1 To nMaxF - 4
For C = B + 1 To nMaxF - 3
For D = C + 1 To nMaxF - 2
For E = D + 1 To nMaxF - 1
For F = E + 1 To nMaxF

sum = results(A) + results(B) + results(C) + results(D) + results(E) +
results(F)

nType(sum) = nType(sum) + 1

Next F
Next E
Next D
Next C
Next B
Next A

For i = 11 To 70
ActiveCell.Offset(0, 0).Value = "Sum Of Digits ="
ActiveCell.Offset(0, 1).Value = i
ActiveCell.Offset(0, 2).Value = nType(i)
ActiveCell.Offset(1, 0).Select
Next i

ActiveCell.Offset(0, 0).Value = "Total Combinations Produced"
sum = 0
For i = 1 To 70
sum = sum + nType(i)
Next i
ActiveCell.Offset(0, 2).Value = sum

ActiveCell.Offset(2, 0) = "This Program Took " & _
Format(((Timer - Start) / 24 / 60 / 60), "hh:mm:ss") & " To Process "

Range("B68").Select
Application.ScreenUpdating = True
End Sub
 
P

Paul Black

Brilliant Joel, thanks very much.

My final program on this is to calculate the first digits.
I know using Int(i \ 10) gives the correct results for numbers 10 to
49 ( 1 to 4 ) but NOT for numbers 1 to 9, it gives zeros. I have
adapted the code to try and achieve this but it will not work.
Here is the code :-

Option Explicit
Option Base 1
Sub First_Digits()
Dim Start As Double
Start = Timer
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 i As Integer
Dim nMinA As Integer
Dim nMaxF As Integer
Dim nType(9) As Double
Dim sum As Long
Application.ScreenUpdating = False
'Sheets("Results").Select
Range("B4").Select
Dim results(49) As Long

nMinA = 1
nMaxF = 49

For i = 1 To 9
nType(i) = 0
Next i

For i = nMinA To nMaxF
results(i) = Int(i \ 10)
Next i

For A = nMinA To nMaxF - 5
For B = A + 1 To nMaxF - 4
For C = B + 1 To nMaxF - 3
For D = C + 1 To nMaxF - 2
For E = D + 1 To nMaxF - 1
For F = E + 1 To nMaxF

sum = results(A) + results(B) + results(C) + results(D) + results(E)
+ results(F)

nType(sum) = nType(sum) + 1

Next F
Next E
Next D
Next C
Next B
Next A

For i = 1 To 9
ActiveCell.Offset(0, 0).Value = "First Digits ="
ActiveCell.Offset(0, 1).Value = i
ActiveCell.Offset(0, 2).Value = nType(i)
ActiveCell.Offset(1, 0).Select
Next i

ActiveCell.Offset(0, 0).Value = "Total Combinations Produced"
sum = 0
For i = 1 To 9
sum = sum + nType(i)
Next i
ActiveCell.Offset(0, 2).Value = sum

ActiveCell.Offset(2, 0) = "This Program Took " & _
Format(((Timer - Start) / 24 / 60 / 60), "hh:mm:ss") & " To
Process "

Range("B68").Select
Application.ScreenUpdating = True
End Sub

Thanks in Advance.
All the Best.
Paul
 
J

Joel

nMinA = 1
nMaxF = 49

For i = nMinA to 9
nType(i) = 0
results(i) = i
Next i

For i = 10 To nMaxF
nType(i) = 0
results(i) = Int(i \ 10)
Next i
 
P

Paul Black

Thanks Joel,

The code now is ...

Option Explicit
Option Base 1
Sub First_Digits()
Dim Start As Double
Start = Timer
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 i As Integer
Dim nMinA As Integer
Dim nMaxF As Integer
Dim nType(9) As Double
Dim sum As Long
Application.ScreenUpdating = False
Range("B4").Select
Dim results(49) As Long

nMinA = 1
nMaxF = 49

For i = nMinA To 9
nType(i) = 0
results(i) = i
Next i

For i = 10 To nMaxF
nType(i) = 0
results(i) = Int(i \ 10)
Next i

For A = nMinA To nMaxF - 5
For B = A + 1 To nMaxF - 4
For C = B + 1 To nMaxF - 3
For D = C + 1 To nMaxF - 2
For E = D + 1 To nMaxF - 1
For F = E + 1 To nMaxF

sum = results(A) + results(B) + results(C) + results(D) +
results(E) + results(F)
nType(sum) = nType(sum) + 1

Next F
Next E
Next D
Next C
Next B
Next A

For i = 1 To 9
ActiveCell.Offset(0, 0).Value = "First Digits ="
ActiveCell.Offset(0, 1).Value = i
ActiveCell.Offset(0, 2).Value = nType(i)
ActiveCell.Offset(1, 0).Select
Next i

ActiveCell.Offset(0, 0).Value = "Total Combinations Produced"
sum = 0
For i = 1 To 9
sum = sum + nType(i)
Next i
ActiveCell.Offset(0, 2).Value = sum

ActiveCell.Offset(2, 0) = "This Program Took " & _
Format(((Timer - Start) / 24 / 60 / 60), "hh:mm:ss") & " To Process
"

Range("B68").Select
Application.ScreenUpdating = True
End Sub

.... but I keep getting an error on line ...

nType(i) = 0

.... and if I edit it out I get an error on line ...

nType(sum) = nType(sum) + 1

.... for some reason.

Thanks in Advance.
All the Best.
Paul
 
P

Paul Black

Hi Joel,

It is basically ...

Fisrst Digit 1 = 1 10 11 12 13 14 15 16 17 18
19
Fisrst Digit 2 = 2 20 21 22 23 24 25 26 27 28
29
Fisrst Digit 3 = 3 30 31 32 33 34 35 36 37 38
39
Fisrst Digit 4 = 4 40 41 42 43 44 45 46 47 48
49
Fisrst Digit 5 = 5
Fisrst Digit 6 = 6
Fisrst Digit 7 = 7
Fisrst Digit 8 = 8
Fisrst Digit 9 = 9

.... if that makes more sense.

Thanks in Advance.
All the Best.
Paul
 
J

Joel

Paul: Not sure what you are doing this time. If you have 6 numbers (A to F)
and you are looking at the 1st digits then the maximum sum of the 1st digits
is 9 + 8 + 7 + 6 + 5 + 4 = 39. Your code only has 9 instead of 39

I changed
from:
ActiveCell.Offset(0, 0).Value = "First Digits ="
to:
ActiveCell.Offset(0, 0).Value = "Sum First Digits ="



Option Explicit
Option Base 1
Sub First_Digits()
Dim Start As Double
Start = Timer
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 i As Integer
Dim nMinA As Integer
Dim nMaxF As Integer
Dim nType(39) As Double
Dim sum As Long
Application.ScreenUpdating = False
Range("B4").Select
Dim results(49) As Long

nMinA = 1
nMaxF = 49

For i = 1 To 39
nType(i) = 0
Next i

For i = nMinA To 9
results(i) = i
Next i

For i = 10 To nMaxF
results(i) = Int(i \ 10)
Next i

For A = nMinA To nMaxF - 5
For B = A + 1 To nMaxF - 4
For C = B + 1 To nMaxF - 3
For D = C + 1 To nMaxF - 2
For E = D + 1 To nMaxF - 1
For F = E + 1 To nMaxF

sum = results(A) + results(B) + results(C) + _
results(D) + results(E) + results(F)
nType(sum) = nType(sum) + 1

Next F
Next E
Next D
Next C
Next B
Next A

For i = 1 To 39
ActiveCell.Offset(0, 0).Value = "Sum First Digits ="
ActiveCell.Offset(0, 1).Value = i
ActiveCell.Offset(0, 2).Value = nType(i)
ActiveCell.Offset(1, 0).Select
Next i

ActiveCell.Offset(0, 0).Value = "Total Combinations Produced"
sum = 0
For i = 1 To 39
sum = sum + nType(i)
Next i
ActiveCell.Offset(0, 2).Value = sum

ActiveCell.Offset(2, 0) = "This Program Took " & _
Format(((Timer - Start) / 24 / 60 / 60), "hh:mm:ss") & _
" To Process"


Range("B68").Select
Application.ScreenUpdating = True
End Sub
 
P

Paul Black

Hi Joel,

The code ...

Option Explicit
Option Base 1

Private FirstDigits(6) As Long
Private Counts(10) As Long
Private Map(10) As Long

Sub First_Digit()
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

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

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) = 51000
Map(10) = 60000

For n = 1 To 10
Counts(n) = 0
Next n

For A = 1 To 44
FirstDigits(1) = Int(A / 10)
For B = A + 1 To 45
FirstDigits(2) = Int(B / 10)
For C = B + 1 To 46
FirstDigits(3) = Int(C / 10)
For D = C + 1 To 47
FirstDigits(4) = Int(D / 10)
For E = D + 1 To 48
FirstDigits(5) = Int(E / 10)
For F = E + 1 To 49
FirstDigits(6) = Int(F / 10)

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

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Private Sub UpdateCounts()
Dim Cnt(0 To 4) As Long
Dim n As Long
Dim j As Long
Dim max As Long
Dim pattern As Long

For n = 1 To 6
Cnt(FirstDigits(n)) = Cnt(FirstDigits(n)) + 1
Next n

For n = 0 To 4
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

.... works OK but assumes that the numbers 1 to 9 are double digit
numbers, so 1 to 9 is actually 01 to 09.
I would like to adapt this code so that the numbers 1 to 9 are classed
as 1 to 9 NOT 01 to 09.
The answer should be something like ...

111111 = 203324 Combinations
211110 = 2336400 Combinations
221100 = 4374150 Combinations
222000 = 665500 Combinations
311100 = 2300760 Combinations
321000 = 2940300 Combinations
330000 = 163350 Combinations
411000 = 710160 Combinations
420000 = 217800 Combinations
510000 = 70224 Combinations
600000 = 1848 Combinations
Totals > = 13983816 Combinations

.... please.

Thanks in Advance.
All the Best.
Paul
 
P

Paul Black

Hi Joel,

The code ...

Option Explicit
Option Base 1

Private FirstDigits(6) As Long
Private Counts(10) As Long
Private Map(10) As Long

Sub First_Digit()
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

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

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) = 51000
Map(10) = 60000

For n = 1 To 10
Counts(n) = 0
Next n

For A = 1 To 44
FirstDigits(1) = Int(A / 10)
For B = A + 1 To 45
FirstDigits(2) = Int(B / 10)
For C = B + 1 To 46
FirstDigits(3) = Int(C / 10)
For D = C + 1 To 47
FirstDigits(4) = Int(D / 10)
For E = D + 1 To 48
FirstDigits(5) = Int(E / 10)
For F = E + 1 To 49
FirstDigits(6) = Int(F / 10)

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

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Private Sub UpdateCounts()
Dim Cnt(0 To 4) As Long
Dim n As Long
Dim j As Long
Dim max As Long
Dim pattern As Long

For n = 1 To 6
Cnt(FirstDigits(n)) = Cnt(FirstDigits(n)) + 1
Next n

For n = 0 To 4
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

.... works OK but assumes that the numbers 1 to 9 are double digit
numbers, so 1 to 9 is actually 01 to 09.
I would like to adapt this code so that the numbers 1 to 9 are classed
as 1 to 9 NOT 01 to 09.
The answer should be something like ...

111111 = 203324 Combinations
211110 = 2336400 Combinations
221100 = 4374150 Combinations
222000 = 665500 Combinations
311100 = 2300760 Combinations
321000 = 2940300 Combinations
330000 = 163350 Combinations
411000 = 710160 Combinations
420000 = 217800 Combinations
510000 = 70224 Combinations
600000 = 1848 Combinations
Totals > = 13983816 Combinations

.... please.
Basically, if the first digits are 1 to 9 then use the first digits 1
to 9 in the counts, otherwise use INT(A/10) etc.

Thanks in Advance.
All the Best.
Paul
 
P

Paul Black

Hi Joel,

The code ...

Option Explicit
Option Base 1

Private FirstDigits(6) As Long
Private Counts(10) As Long
Private Map(10) As Long

Sub First_Digit()
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

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

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) = 51000
Map(10) = 60000

For n = 1 To 10
Counts(n) = 0
Next n

For A = 1 To 44
FirstDigits(1) = Int(A / 10)
For B = A + 1 To 45
FirstDigits(2) = Int(B / 10)
For C = B + 1 To 46
FirstDigits(3) = Int(C / 10)
For D = C + 1 To 47
FirstDigits(4) = Int(D / 10)
For E = D + 1 To 48
FirstDigits(5) = Int(E / 10)
For F = E + 1 To 49
FirstDigits(6) = Int(F / 10)

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

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Private Sub UpdateCounts()
Dim Cnt(0 To 4) As Long
Dim n As Long
Dim j As Long
Dim max As Long
Dim pattern As Long

For n = 1 To 6
Cnt(FirstDigits(n)) = Cnt(FirstDigits(n)) + 1
Next n

For n = 0 To 4
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

.... works OK but assumes that the numbers 1 to 9 are double digit
numbers, so 1 to 9 is actually 01 to 09.
I would like to adapt this code so that the numbers 1 to 9 are
classed
as 1 to 9 NOT 01 to 09.
The answer should be something like ...

111111 = 203324 Combinations
211110 = 2336400 Combinations
221100 = 4374150 Combinations
222000 = 665500 Combinations
311100 = 2300760 Combinations
321000 = 2940300 Combinations
330000 = 163350 Combinations
411000 = 710160 Combinations
420000 = 217800 Combinations
510000 = 70224 Combinations
600000 = 1848 Combinations
Totals > = 13983816 Combinations

.... please.
Basically, if the first digits are 1 to 9 then use the first digits 1
to 9 in the counts, otherwise use INT(A/10) etc.
Something like ...

For A = 1 To 44
If FirstDigits(1) <= 9 Then
FirstDigits(1) = FirstDigits(1)
Else
FirstDigits(1) = Int(A / 10)
End If

.... etc.

Thanks in Advance.
All the Best.
Paul
 
J

Joel

Try this. It takes a long time to run. I did not let it finish. The first
digits are now 1 to 9 which increase run time. I changed the way the pattern
is found by doing a sort. Notice the sort time is better than 1/2x where x
is the run time the code you had.

Notice I used j = i + 1 which reduces the run time in 1/2.

I did a buble sort which bring the highest value to the cnt(1). Then when
you do i = 2 you don't have to compare it with cnt(1) because it is already
the highest. You also only have to do i = 1 to 6 (not i = 1 to 9) because
you only have 6 number.

Look at the code. If you have questions ask.


Option Explicit
Option Base 1

Private FirstDigits(6) As Long
Private Counts(10) As Long
Private Map(10) As Long

Sub First_Digit()
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
Dim First(49)

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

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) = 51000
Map(10) = 60000

For n = 1 To 10
Counts(n) = 0
Next n
For n = 1 To 49
If n <= 9 Then
First(n) = n
Else
First(n) = Int(n / 10)
End If
Next n

For A = 1 To 44
FirstDigits(1) = First(A)
For B = A + 1 To 45
FirstDigits(2) = First(B)
For C = B + 1 To 46
FirstDigits(3) = First(C)
For D = C + 1 To 47
FirstDigits(4) = First(D)
For E = D + 1 To 48
FirstDigits(5) = First(E)
For F = E + 1 To 49
FirstDigits(6) = First(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

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Private Sub UpdateCounts()
Dim Cnt(0 To 9) As Long
Dim n As Long
Dim i As Long
Dim j As Long
Dim temp As Long
Dim max As Long
Dim pattern As Double

For n = 1 To 6
Cnt(FirstDigits(n)) = Cnt(FirstDigits(n)) + 1
Next n

'sort cnt
pattern = 0
For i = 1 To 6
For j = (i + 1) To 9
If Cnt(j) > Cnt(i) Then
temp = Cnt(j)
Cnt(j) = Cnt(i)
Cnt(i) = temp
End If
Next j
pattern = pattern * 10 + Cnt(i)
Next i

For n = 1 To UBound(Map)
If Map(n) = pattern Then
Counts(n) = Counts(n) + 1
Exit For
End If
Next n
End Sub
 
J

Joel

Your maps have only 5 digits instead of 6???? Add 1 digit
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) = 51000
Map(10) = 60000
 
P

Paul Black

Outstanding Joel, it works like a dream.
Here is the finished code including the new Mappings and adjusted
parameters ...

Option Explicit
Option Base 1

Private FirstDigits(6) As Long
Private Counts(11) As Long
Private Map(11) As Long

Sub First_Digit()
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
Dim First(49)

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Map(1) = 111111
Map(2) = 211110
Map(3) = 221100
Map(4) = 222000
Map(5) = 311100
Map(6) = 321000
Map(7) = 330000
Map(8) = 411000
Map(9) = 420000
Map(10) = 510000
Map(11) = 600000

For n = 1 To 11
Counts(n) = 0
Next n
For n = 1 To 49
If n <= 9 Then
First(n) = n
Else
First(n) = Int(n / 10)
End If
Next n

For A = 1 To 44
FirstDigits(1) = First(A)
For B = A + 1 To 45
FirstDigits(2) = First(B)
For C = B + 1 To 46
FirstDigits(3) = First(C)
For D = C + 1 To 47
FirstDigits(4) = First(D)
For E = D + 1 To 48
FirstDigits(5) = First(E)
For F = E + 1 To 49
FirstDigits(6) = First(F)

UpdateCounts

Next F
Next E
Next D
Next C
Next B
Next A

Range("A1").Select

For n = 1 To 11
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

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub


Private Sub UpdateCounts()
Dim Cnt(1 To 9) As Long
Dim n As Long
Dim i As Long
Dim j As Long
Dim temp As Long
Dim max As Long
Dim pattern As Double

For n = 1 To 6
Cnt(FirstDigits(n)) = Cnt(FirstDigits(n)) + 1
Next n

'sort cnt
pattern = 0
For i = 1 To 6
For j = (i + 1) To 9
If Cnt(j) > Cnt(i) Then
temp = Cnt(j)
Cnt(j) = Cnt(i)
Cnt(i) = temp
End If
Next j
pattern = pattern * 10 + Cnt(i)
Next i

For n = 1 To UBound(Map)
If Map(n) = pattern Then
Counts(n) = Counts(n) + 1
Exit For
End If
Next n
End Sub

Are the lines ...

Private Counts(11) As Long
Private Map(11) As Long

.... and ...

For n = 1 To 11
Counts(n) = 0
Next n

.... and ...

For n = 1 To 11
Total = Total + Counts(n)

.... and ...

Dim Cnt(1 To 9) As Long

.... and ...

For j = (i + 1) To 9

.... correct please.
I find it confusing that there is a variable "n" in both Subs though,
does this have to be the case.
Also, can the lines ...

FirstDigits(1) = First(A)

.... etc be put before the "For ... Next" loops in order to speed the
code up, similar to what Dana used previously?.

Thanks in Advance.
All the Best.
Paul.
 
J

Joel

Answer to questions.

1) Your code has Option Base 1 which means arrays start at 1 (not 0).
Are the lines ...

2) Private Counts(11) As Long
Counts technically go from the digit 0 to the digit 9. We eliminated zero
from the digits with the last update. So we have only 1 to 9. Therrefore
Counts should be Counts(9). It can also be changed to an Integer instead of
a long.

3) Private Map(11) As Long

Map(11) as Long is correct. It is the number of patterns you are looking
for starting at a count of 1.

Long (long integer) variables are stored as signed 32-bit (4-byte) numbers
ranging in value from -2,147,483,648 to 2,147,483,647. The type-declaration
character for Long is the ampersand (&).

4) n in this case below should be the same size as patttern

For n = 1 To 11 map
Counts(n) = 0
Next n

..... and ...

For n = 1 To 11
Total = Total + Counts(n)

5) Cnt is the number of 1st digitas which is 1 to 9

Dim Cnt(1 To 9) As Long

..... and ...

For j = (i + 1) To 9

6) n is a local variable whose scope does not need to be global (used by
both main routine and sub function). There is no need to make n global
(public). Making it global may increase the run time of the program because
it may use a longer address to find the variable.

The scope of a variable life is where it is defined. Public variable a
regonized everywhere. Local variables are recognized only in the routine
where they are used.

..... correct please.
I find it confusing that there is a variable "n" in both Subs though,
does this have to be the case.

7) The line below where the are presently located. the variable A is not
defined until the For statement is executed.

Also, can the lines ...

FirstDigits(1) = First(A)

..... etc be put before the "For ... Next" loops in order to speed the
code up, similar to what Dana used previously?.

Thanks in Advance.
All the Best.
Paul
 
P

Paul Black

Thanks for the reply and detailed explanation, it is appreciated.

I have amended the code ...

Option Explicit
Option Base 1

Private FirstDigits(6) As Long
Private Counts(9) As Integer
Private Map(11) As Long

Sub First_Digit()
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
Dim First(49)

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Map(1) = 111111
Map(2) = 211110
Map(3) = 221100
Map(4) = 222000
Map(5) = 311100
Map(6) = 321000
Map(7) = 330000
Map(8) = 411000
Map(9) = 420000
Map(10) = 510000
Map(11) = 600000

For n = 1 To 11
Counts(n) = 0
Next n
For n = 1 To 49
If n <= 9 Then
First(n) = n
Else
First(n) = Int(n / 10)
End If
Next n

For A = 1 To 44
FirstDigits(1) = First(A)
For B = A + 1 To 45
FirstDigits(2) = First(B)
For C = B + 1 To 46
FirstDigits(3) = First(C)
For D = C + 1 To 47
FirstDigits(4) = First(D)
For E = D + 1 To 48
FirstDigits(5) = First(E)
For F = E + 1 To 49
FirstDigits(6) = First(F)

UpdateCounts

Next F
Next E
Next D
Next C
Next B
Next A

Range("A1").Select

For n = 1 To 11
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

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Private Sub UpdateCounts()
Dim Cnt(1 To 9) As Long
Dim n As Long
Dim i As Long
Dim j As Long
Dim temp As Long
Dim max As Long
Dim pattern As Double

For n = 1 To 6
Cnt(FirstDigits(n)) = Cnt(FirstDigits(n)) + 1
Next n

'sort cnt
pattern = 0
For i = 1 To 6
For j = (i + 1) To 9
If Cnt(j) > Cnt(i) Then
temp = Cnt(j)
Cnt(j) = Cnt(i)
Cnt(i) = temp
End If
Next j
pattern = pattern * 10 + Cnt(i)
Next i

For n = 1 To UBound(Map)
If Map(n) = pattern Then
Counts(n) = Counts(n) + 1
Exit For
End If
Next n
End Sub

.... but get a subscript out of range, Run-time error 9 on line ...

Counts(n) = 0

Thanks in Advance.
All the Best.
Paul
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Formula help, please. 3
Incrementing IPv6 address 1
How to get a value from 1 table to a 2nd. 15
Help With Total of Values Please 8
Help with Grand Total and Positioning Please 4
writing a value to a particular cell from function 3
Function to convert CUSIP code to ISIN code cusipconv() 1
Adjusting height of text cells 3

Top