Hi everyone,

Two questions then please.
(1) I have included ...

ActiveCell.Offset(j + 2, 0) = "'" & Application.Run("ATPVBAEN.XLA!
DEC2BIN", j, 6)

.... to the code as per Tom Ogilvy which works great.
Is there a way to get the program to use this INSTEAD of using ALL
the ...

If nVal = 0 Then nSum(1) = nSum(1) + 1

.... statements please.

(2) Is there a way to use a Function or something for the "Select
Case" statements so they are not included in the actual main program
itself please.

Thanks in Advance.
All the Beat.
Paul

On Sep 28, 10:03 am, Paul Black wrote:
Hi Tom,

I have included your code and adapted it slightly by adding ...

ActiveCell.Offset(j + 2, 0).Errors(xlNumberAsText).Ignore = True

... to stop it from throwing the "Number Stored as Text" error. I have
also changed a couple of other things and have come up with :-

Option Explicit

Sub Distribution()
Dim A As Integer, B As Integer, C As Integer, D As Integer, E As
Integer, F As Integer
Dim minVal As Integer
Dim maxVal As Integer
Dim nVal As Double
Dim nSum(64) As Double
Dim i As Integer
Dim j As Integer

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

minVal = 1
maxVal = 49

Worksheets("Output").Select
With Worksheets("Output")
Cells.Select
Selection.Delete Shift:=xlUp
End With

Range("B2").Select

For i = 1 To 64
nSum(i) = 0
Next i

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

Select Case A
Case 1, 3, 5, 7, 9, 11, 13, 15, 17, 19, 21, 23, 25, 27,
29, 31, 33, 35, 37, 39, 41, 43, 45, 47, 49
nVal = 100000
End Select
Select Case B
Case 1, 3, 5, 7, 9, 11, 13, 15, 17, 19, 21, 23, 25, 27,
29, 31, 33, 35, 37, 39, 41, 43, 45, 47, 49
nVal = nVal + 10000
End Select
Select Case C
Case 1, 3, 5, 7, 9, 11, 13, 15, 17, 19, 21, 23, 25, 27,
29, 31, 33, 35, 37, 39, 41, 43, 45, 47, 49
nVal = nVal + 1000
End Select
Select Case D
Case 1, 3, 5, 7, 9, 11, 13, 15, 17, 19, 21, 23, 25, 27,
29, 31, 33, 35, 37, 39, 41, 43, 45, 47, 49
nVal = nVal + 100
End Select
Select Case E
Case 1, 3, 5, 7, 9, 11, 13, 15, 17, 19, 21, 23, 25, 27,
29, 31, 33, 35, 37, 39, 41, 43, 45, 47, 49
nVal = nVal + 10
End Select
Select Case F
Case 1, 3, 5, 7, 9, 11, 13, 15, 17, 19, 21, 23, 25, 27,
29, 31, 33, 35, 37, 39, 41, 43, 45, 47, 49
nVal = nVal + 1
End Select

If nVal = 0 Then nSum(1) = nSum(1) + 1
If nVal = 1 Then nSum(2) = nSum(2) + 1
If nVal = 10 Then nSum(3) = nSum(3) + 1
If nVal = 11 Then nSum(4) = nSum(4) + 1
If nVal = 100 Then nSum(5) = nSum(5) + 1
If nVal = 101 Then nSum(6) = nSum(6) + 1
If nVal = 110 Then nSum(7) = nSum(7) + 1
If nVal = 111 Then nSum(8) = nSum(8) + 1
If nVal = 1000 Then nSum(9) = nSum(9) + 1
If nVal = 1001 Then nSum(10) = nSum(10) + 1
If nVal = 1010 Then nSum(11) = nSum(11) + 1
If nVal = 1011 Then nSum(12) = nSum(12) + 1
If nVal = 1100 Then nSum(13) = nSum(13) + 1
If nVal = 1101 Then nSum(14) = nSum(14) + 1
If nVal = 1110 Then nSum(15) = nSum(15) + 1
If nVal = 1111 Then nSum(16) = nSum(16) + 1
If nVal = 10000 Then nSum(17) = nSum(17) + 1
If nVal = 10001 Then nSum(18) = nSum(18) + 1
If nVal = 10010 Then nSum(19) = nSum(19) + 1
If nVal = 10011 Then nSum(20) = nSum(20) + 1
If nVal = 10100 Then nSum(21) = nSum(21) + 1
If nVal = 10101 Then nSum(22) = nSum(22) + 1
If nVal = 10110 Then nSum(23) = nSum(23) + 1
If nVal = 10111 Then nSum(24) = nSum(24) + 1
If nVal = 11000 Then nSum(25) = nSum(25) + 1
If nVal = 11001 Then nSum(26) = nSum(26) + 1
If nVal = 11010 Then nSum(27) = nSum(27) + 1
If nVal = 11011 Then nSum(28) = nSum(28) + 1
If nVal = 11100 Then nSum(29) = nSum(29) + 1
If nVal = 11101 Then nSum(30) = nSum(30) + 1
If nVal = 11110 Then nSum(31) = nSum(31) + 1
If nVal = 11111 Then nSum(32) = nSum(32) + 1
If nVal = 100000 Then nSum(33) = nSum(33) + 1
If nVal = 100001 Then nSum(34) = nSum(34) + 1
If nVal = 100010 Then nSum(35) = nSum(35) + 1
If nVal = 100011 Then nSum(36) = nSum(36) + 1
If nVal = 100100 Then nSum(37) = nSum(37) + 1
If nVal = 100101 Then nSum(38) = nSum(38) + 1
If nVal = 100110 Then nSum(39) = nSum(39) + 1
If nVal = 100111 Then nSum(40) = nSum(40) + 1
If nVal = 101000 Then nSum(41) = nSum(41) + 1
If nVal = 101001 Then nSum(42) = nSum(42) + 1
If nVal = 101010 Then nSum(43) = nSum(43) + 1
If nVal = 101011 Then nSum(44) = nSum(44) + 1
If nVal = 101100 Then nSum(45) = nSum(45) + 1
If nVal = 101101 Then nSum(46) = nSum(46) + 1
If nVal = 101110 Then nSum(47) = nSum(47) + 1
If nVal = 101111 Then nSum(48) = nSum(48) + 1
If nVal = 110000 Then nSum(49) = nSum(49) + 1
If nVal = 110001 Then nSum(50) = nSum(50) + 1
If nVal = 110010 Then nSum(51) = nSum(51) + 1
If nVal = 110011 Then nSum(52) = nSum(52) + 1
If nVal = 110100 Then nSum(53) = nSum(53) + 1
If nVal = 110101 Then nSum(54) = nSum(54) + 1
If nVal = 110110 Then nSum(55) = nSum(55) + 1
If nVal = 110111 Then nSum(56) = nSum(56) + 1
If nVal = 111000 Then nSum(57) = nSum(57) + 1
If nVal = 111001 Then nSum(58) = nSum(58) + 1
If nVal = 111010 Then nSum(59) = nSum(59) + 1
If nVal = 111011 Then nSum(60) = nSum(60) + 1
If nVal = 111100 Then nSum(61) = nSum(61) + 1
If nVal = 111101 Then nSum(62) = nSum(62) + 1
If nVal = 111110 Then nSum(63) = nSum(63) + 1
If nVal = 111111 Then nSum(64) = nSum(64) + 1

nVal = 0

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

For j = 0 To 63
For i = 1 To 64
ActiveCell.Offset(j + 2, 0) = "'" & Application.Run("ATPVBAEN.XLA!
DEC2BIN", j, 6)
ActiveCell.Offset(j + 2, 0).Errors(xlNumberAsText).Ignore = True
ActiveCell.Offset(i + 1, 1).Value = nSum(i)
Next i
Next j

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub[/code]

A few questions please.
(1) How could I instead of using six "For ... Next" loops make it a
recursive algorithm?.
(2) Is there an advantage to using "Const" for "minVal", "maxVal" &
"TotalComb" in this program as far as speed and changeability is
concerned rather than hard coded values?.
(3) How can I add a total for "nSum(i)" assuming that the length of
column "C" could vary please?. Much like a floating total that will
put the total underneath regardless of how many cellsl to add.
Preferably NOT inputing the actual formula itself.
(4) Is there anyway I can improve the code above?. For example, how
can I make a "Select Case" Function instead of having it within the
main code itself?.
(5) Is there a way I can shorten the "If nVal Then" code because I
have the "nSum(i)".

Thanks in Advance.
All the Best.Paul

On Sep 26, 2:22 pm, Tom Ogilvy
wrote:



The two double quotes had a single quote between them like this:

Sub BBBb()
Range("A1").Select

For I = 2 To 65
Cells(I, 2) = "'" & _
Application.Run("ATPVBAEN.XLA!DEC2BIN", I - 2, 6)
Next

End Sub

You left that out. The original suggested (containing the single quote)
and this modified to add the single quote both worked for me.

--
Regards,
Tom Ogilvy

"PaulBlack" wrote:
Thanks Tom (red face!),

I am using xl2002 and although I had the Analysis ToolPak installed I
did NOT have the Analysis ToolPak - VBA installed.
I amended the code to ...

Sub BBB()
Range("A1").Select

For I = 2 To 65
Cells(I, 2) = "" & Application.Run("ATPVBAEN.XLA!DEC2BIN", I - 2, 6)
Next

End Sub

.... but unfortunatel it does not give me the 6 places for all of them.

Thanks in Advance.
All the Best.
Paul

On Sep 26, 1:50 pm, Tom Ogilvy
wrote:
Are you using xl2007? I understand the Analysis toolpak functions were made
built in functions in xl2007. If not, then you need to load the Analysist
Tookpak - VBA as well as the Analysis Tookpak.

--
Regards,
Tom Ogilvy

"PaulBlack" wrote:
Thanks Tom,

I started with a blank worksheet and amended the code as per your
instructions.
It still keeps saying ATPVBAEN.XLA could NOT be found though.

Thanks in Advance.
All the Best.
Paul

On Sep 26, 1:28 pm, Tom Ogilvy
wrote:
Also, I guess you said you wanted a 6 character result, so this does that:

Sub BBB()
For i = 2 To 62
Cells(i, 2) = "'" & _
Application.Run("ATPVBAEN.XLA!DEC2BIN", i - 2, 6)
Next

End Sub

starting in B1:

000000
000001
000010
000011
000100
000101
000110
000111
001000
001001

. . .

--
regards,
Tom Ogilvy

"PaulBlack" wrote:
Hi Tom,

It has come up with an error saying that ATPVBAEN.XLA!DEC2BIN cannot
be found and make sure it is installed, which it is. Is this because
ATPVBAEN.XLA!BIN2DEC exists but not ATPVBAEN.XLA!DEC2BIN please.

Thanks in Advance.
All the Best.
Paul

On Sep 26, 12:48 wrote:
Thanks for the reply Tom,

Is there a way so I don't need to actually input the 0 to 63 values in
the spreadsheet please. What I mean by that is get the program to
calculate the 0 to 63 and use them

...

read more »- Hide quoted text -

- Show quoted text -