Using DEC2BIN(range,6) in VBA Code

[Paul Black]

Hi everyone,

At the moment I input the vales 0 to 63 in cells "B2:B65".
I input the Formula =DEC2BIN(B2,6) into cell "C2" and copy it down to
cell "C65".
The =DEC2BIN(range,6) is an engineering function that converts
"Decimal" to "Binary". For anybody wanting to use this the Analysis
ToolPak needs to be installed (which I have).

I have the code :-

Range("A1").Select

For I = 1 To 64
ActiveCell.Offset(I, 2).Value = nSum(I)
Next I

The output starts in cell "D2" and continues down to cell "D65" and
works great.
Is there anyway that I can use the DEC2BIN(range,6) so the code
calculates it and outputs the answer, preferably not getting it to
output the formula itself into the worksheet. I would ideally like the
figures produced to be output to cells "C2:C65" please.

Thanks in Advance.
All the Best.
Paul

 

[Tom Ogilvy]

For i = 2 to 65
Cells(i,"C").Value = Application.Run("ATPVBAEN.XLA!DEC2BIN",Cells(i,"B"))
Next

 

[Paul Black]

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 instead of the spreadsheet figures
because I don't actually need the 0 to 63 figures at all, they are
only there to work out the DEC2BIN(range,6) values.

Thanks in Advance.
All the Best.
Paul

 

[Paul Black]

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

 

[Tom Ogilvy]

? application.Run( "ATPVBAEN.XLA!DEC2BIN",125)
1111101

works fine as you can see from the above demo in the immediate window

Sub ABC()
for i = 2 to 62
cells(i,2) = application.Run( "ATPVBAEN.XLA!DEC2BIN",i-2)
Next
end sub


starting in B2 produced:

0
1
10
11
100
101
110
111
1000
1001
.. . .

 

[Tom Ogilvy]

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

.. . .

 

[Paul Black]

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

 

[Tom Ogilvy]

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.

 

[Paul Black]

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

 

[Peter T]

You said in your OP you have Analysis ToolPak (Funcres.xla) installed, but
what about 'Analysis ToolPak - VBA' (ATPVBAEN.XLA)

FWIW while developing, if not permanently, it can also help to add a
reference to the addin in your project, which for some reason becomes listed
as 'atpvbaen.xls' (ie xls not xla).

will get the intellisense as you type

x = dec2bin(

Regards,
Peter T

 

[Tom Ogilvy]

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.

 

[Paul Black]

Brilliant Tom,

That works great.
I added ...

Cells(I, 2).Errors(xlNumberAsText).Ignore = True

.... to stop it from throwing the "Number Stored as Text" error.

Thanks VERY much.
All the Best.
Paul

 

[Paul Black]

Hi Tom,

I have included your code and adapted it slightly and come up with ...
For j = 0 To 63
For I = 1 To 64
ActiveCell.Offset(j + 1, 1) = "'" & Application.Run("ATPVBAEN.XLA!
DEC2BIN", j, 6)
ActiveCell.Offset(j + 1, 1).Errors(xlNumberAsText).Ignore = True
ActiveCell.Offset(I, 2).Value = nSum(I)
Next I
Next j
.... which works great.

Last request on this, I promise.
How can I add a total 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.

Thanks in Advance.
All the Best.
Paul

 

[Paul Black]

Hi Tom,

I have finished the program all but ...

How can I add a total 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.

- Show quoted text -

Is there anyway I can improve the code below please, For example, how
can I make a select case function instead of having it within the main
code.
Also, is there a way I can shorten the If nVal Then code because I
have the nSum(i).
Here is the code :-

Option Explicit

Sub Odd_and_Even()
Dim A As Integer, B As Integer, C As Integer, D As Integer, E As
Integer, F As Integer
Dim nVal As Double
Dim nSum(64) As Double
Dim i As Integer
Dim j As Integer
Dim TotalComb As Long

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

TotalComb = 13983816

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

Range("B2").Select

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

For A = 1 To 44
For B = A + 1 To 45
For C = B + 1 To 46
For D = C + 1 To 47
For E = D + 1 To 48
For F = E + 1 To 49

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(j + 2, 0).Resize(1, 5).Borders.LineStyle =
xlContinuous
ActiveCell.Offset(i + 1, 1).Value = nSum(i)
ActiveCell.Offset(i + 1, 1).NumberFormat = "#,###,##0"
ActiveCell.Offset(i + 1, 2).Value = 100 / TotalComb * nSum(i)
ActiveCell.Offset(i + 1, 2).NumberFormat = "##0.00"
ActiveCell.Offset(i + 1, 3).Value = TotalComb / nSum(i)
ActiveCell.Offset(i + 1, 3).NumberFormat = "0.00"
ActiveCell.Offset(i + 1, 4).Value = "Draws"
ActiveCell.Offset(i + 1, 4).HorizontalAlignment = xlRight
Next i
Next j

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

Thanks in Advance.
All the Best.
Paul

 

[Paul Black]

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

 

[Paul Black]

Hi Tom,

I don't know if this helps but I have got the total to work for the
"nSum(i)" by using ...

ActiveCell.Offset(j + 3, 1).FormulaR1C1 = "=Sum(R4C3:R[-1]C)"
ActiveCell.Offset(j + 3, 1).Formula = ActiveCell.Offset(j + 3,
1).Value

.... because I want the total for cells "C4:C67" in this particular
case. The only thing with this is that if the ouput starts in cell
"A2" for example, I would have to physically adjust the "R4C3" part of
the formula accordingly. Is there another way to do this please so I
will NOT have to worry what the start or end cells are to be summed.

Thanks in Advance.
All the Best.
Paul

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

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.

...

read more »- Hide quoted text -

- Show quoted text -

 

[Paul Black]

Hi Tom,

I don't know if this helps but I have got the total to work for the
"nSum(i)" by using ...

ActiveCell.Offset(j + 3, 1).FormulaR1C1 = "=Sum(R4C3:R[-1]C)"
ActiveCell.Offset(j + 3, 1).Formula = ActiveCell.Offset(j + 3,
1).Value

.... because I want the total for cells "C4:C67" in this particular
case. The only thing with this is that if the ouput starts in cell
"A2" for example, I would have to physically adjust the "R4C3" part
of
the formula accordingly. Is there another way to do this please so I
will NOT have to worry what the start or end cells are to be summed.

Thanks in Advance.
All the Best.
Paul

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

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 <[email protected]>
wrote:


read more »- Hide quoted text -

- Show quoted text -

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

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.

...

read more »- Hide quoted text -

- Show quoted text -

 

[Paul Black]

Hi everyone,

Any ideas or suggestions will be greatly appreciated.

Thanks in Advance.
All the Best.
Paul

Hi Tom,

I don't know if this helps but I have got the total to work for the
"nSum(i)" by using ...

ActiveCell.Offset(j + 3, 1).FormulaR1C1 = "=Sum(R4C3:R[-1]C)"
ActiveCell.Offset(j + 3, 1).Formula = ActiveCell.Offset(j + 3,
1).Value

... because I want the total for cells "C4:C67" in this particular
case. The only thing with this is that if the ouput starts in cell
"A2" for example, I would have to physically adjust the "R4C3" part
of
the formula accordingly. Is there another way to do this please so I
will NOT have to worry what the start or end cells are to be summed.

Thanks in Advance.
All the Best.
Paul

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

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
:
Thanks Tom (red face!),
I am using xl2002 and although I had the Analysis ToolPak installedI
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 <[email protected]>
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
:
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 <[email protected]>
wrote:
Also, I guess you said you wanted a 6 character result, so this does that:
Sub BBB()
For i = 2 To 62

...

read more »- Hide quoted text -

- Show quoted text -

 

[Paul Black]

Hi everyone,

Any ideas or suggestions will be greatly appreciated.

Thanks in Advance.
All the Best.
Paul

Hi Tom,

I don't know if this helps but I have got the total to work for the
"nSum(i)" by using ...

ActiveCell.Offset(j + 3, 1).FormulaR1C1 = "=Sum(R4C3:R[-1]C)"
ActiveCell.Offset(j + 3, 1).Formula = ActiveCell.Offset(j + 3,
1).Value

... because I want the total for cells "C4:C67" in this particular
case. The only thing with this is that if the ouput starts in cell
"A2" for example, I would have to physically adjust the "R4C3" part
of
the formula accordingly. Is there another way to do this please so I
will NOT have to worry what the start or end cells are to be summed.

Thanks in Advance.
All the Best.
Paul

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

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
:
Thanks Tom (red face!),
I am using xl2002 and although I had the Analysis ToolPak installedI
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 <[email protected]>
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
:
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 <[email protected]>
wrote:
Also, I guess you said you wanted a 6 character result, so this does that:
Sub BBB()
For i = 2 To 62

...

read more »- Hide quoted text -

- Show quoted text -

 

[Paul Black]

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

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

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.

...

read more »- Hide quoted text -

- Show quoted text -