Loop Not Working

[Paul Black]

Hi everyone,

Why does this not work please. It is suppose to produce a list several
lines long but only produces 1 line.

For cmb = 1 To P
tly = 0
For idx = 0 To (2 ^ P) - 1
If BitCount(idx / 5000) = cmb Then
tly = tly + 1
End If
Next
Range("b32").Select
With ActiveCell
.Offset(0, 0).Value = "W"
.Offset(1, 0).Value = "For " & P & " numbers " & Format(tly,
"#,##0") & _
" different " & cmb & " num. "
.Offset(2, 0).Select
End With
Next

Thanks in Advance.
All the Best.
Paul

 

[Bob Phillips]

What is in BitCount?

What do you expect to see?

--
---
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)

 

[Guest]

Because you always write to the same cell.

Range("b32").Select '<== move this line outside the loop
For cmb = 1 To P
tly = 0
For idx = 0 To (2 ^ P) - 1
If BitCount(idx / 5000) = cmb Then
tly = tly + 1
End If
Next

With ActiveCell
.Offset(0, 0).Value = "W"
.Offset(1, 0).Value = "For " & P & _
" numbers " & Format(tly,"#,##0") & _
" different " & cmb & " num. "
.Offset(2, 0).Select
End With
Next

 

[Paul Black]

Thanks for the replies Bob & Tom,

Here is the code that I can't get to work. It should list several rows
of data starting in cell "B32" and continuing down. The code below
works fine if I want the output to start in cell "A1" but I can't get
it to start in cell "B32".
The other thing is that other output which works fine leaves the
active cell as "B29".

Option Explicit

Private Type Wheel
A As Currency
End Type

Private Type Digits
B(0 To 7) As Byte
End Type

Private BC(0 To 255) As Byte
Private WHL(0 To 20) As Wheel
Private Tested As Long
Private P As Integer

Sub Generate_Statistics()
Dim idx As Currency
Dim tly As Long
Dim cmb As Long
Dim rng As Range

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Set rng = Worksheets("Data").UsedRange.Rows
P = Application.Max(rng)

For idx = 0 To 255
BC(idx) = Nibs(idx And 15) + Nibs(idx \ 16)
Next

For cmb = 1 To P
tly = 0
For idx = 0 To (2 ^ P) - 1
If BitCount(idx / 5000) = cmb Then
tly = tly + 1
End If
Next

Worksheets("Statistics").Select
With ActiveCell
.Offset(0, 0).Value = "Title"
.Offset(0, 1).Value = "For " & P & " numbers there are " & tly &
_
" different groups of " & cmb & " numbers. "
.Offset(1, 0).Select
End With
Next

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

Private Function BitCount(ByVal X As Currency) As Long
Dim W As Wheel
Dim d As Digits
Dim idx As Long
Dim cnt As Long

W.A = X
LSet d = W
For idx = 0 To 7
cnt = cnt + BC(d.B(idx))
Next
BitCount = cnt
End Function

Private Function Nibs(ByVal Value As Byte) As Long
Select Case Value
Case 0
Exit Function
Case 1, 2, 4, 8
Nibs = 1
Exit Function
Case 3, 5, 6, 9, 10, 12
Nibs = 2
Exit Function
Case 7, 11, 13, 14
Nibs = 3
Exit Function
Case 15
Nibs = 4
End Select
End Function

Thanks in Advance.
All the Best.
Paul

 

[Guest]

Sub Generate_Statistics()
Dim idx As Currency
Dim tly As Long
Dim cmb As Long
Dim rng As Range

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Set rng = Worksheets("Data").UsedRange.Rows
P = Application.Max(rng)

For idx = 0 To 255
BC(idx) = Nibs(idx And 15) + Nibs(idx \ 16)
Next

For cmb = 1 To P
tly = 0
For idx = 0 To (2 ^ P) - 1
If BitCount(idx / 5000) = cmb Then
tly = tly + 1
End If
Next

With Worksheets("Statistics").Range("B32")
.Offset(cmb - 1, 0).Value = "Title"
.Offset(cmb - 1, 1).Value = "For " & P & _
" numbers there are " & tly & _
" different groups of " & cmb & " numbers. "
End With
Next

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

 

[Paul Black]

Brilliant Tom, thanks very much.
One last thing please.
I have a sheet named "Statistics". The code below caters for what I
need except for one thing. I need it to add a sheet named "Statistics"
if it does not exist when the program is run.
So basically, if the sheet named "Statistics" exists, delete it, add a
sheet named "Statistics" and make the whole of the sheet Tahoma font.
If it does NOT already exist then add it and make the whole of the
sheet Tahoma font..
This is what I have so far :-

' Delete the existing [Statistics] sheet and ADD a new one
Worksheets("Statistics").Select
Worksheets("Statistics").Delete
Worksheets.Add.Name = "Statistics"

' Format the WHOLE [Statistics] sheet as Tahoma
Cells.Font.Name = "Tahoma"

Thanks in Advanve.
All the Best.
Paul

 

[Guest]

Sub Generate_Statistics()
Dim idx As Currency
Dim tly As Long
Dim cmb As Long
Dim rng As Range
Dim sh as Worksheet
Dim sh1 as Worksheet

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

set sh1 = Activesheet
Application.DisplayAlerts = False
On Error Resume Next
worksheets("Statistics").Delete
On Error goto 0
Application.Displayalerts = True
set sh = worksheets.Add( After:=Worksheets(worksheets.count))
sh.Name = "Statistics"
sh.Cells.Font.Name = "Tahoma"
sh1.activate

Set rng = Worksheets("Data").UsedRange '.Rows
P = Application.Max(rng)

For idx = 0 To 255
BC(idx) = Nibs(idx And 15) + Nibs(idx \ 16)
Next

For cmb = 1 To P
tly = 0
For idx = 0 To (2 ^ P) - 1
If BitCount(idx / 5000) = cmb Then
tly = tly + 1
End If
Next

With Worksheets("Statistics").Range("B32")
.Offset(cmb - 1, 0).Value = "Title"
.Offset(cmb - 1, 1).Value = "For " & P & _
" numbers there are " & tly & _
" different groups of " & cmb & " numbers. "
End With
Next

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

--
Regards,
Tom Ogilvy

Brilliant Tom, thanks very much.
One last thing please.
I have a sheet named "Statistics". The code below caters for what I
need except for one thing. I need it to add a sheet named "Statistics"
if it does not exist when the program is run.
So basically, if the sheet named "Statistics" exists, delete it, add a
sheet named "Statistics" and make the whole of the sheet Tahoma font.
If it does NOT already exist then add it and make the whole of the
sheet Tahoma font..
This is what I have so far :-

' Delete the existing [Statistics] sheet and ADD a new one
Worksheets("Statistics").Select
Worksheets("Statistics").Delete
Worksheets.Add.Name = "Statistics"

' Format the WHOLE [Statistics] sheet as Tahoma
Cells.Font.Name = "Tahoma"

Thanks in Advanve.
All the Best.
Paul

Sub Generate_Statistics()
Dim idx As Currency
Dim tly As Long
Dim cmb As Long
Dim rng As Range

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Set rng = Worksheets("Data").UsedRange.Rows
P = Application.Max(rng)

For idx = 0 To 255
BC(idx) = Nibs(idx And 15) + Nibs(idx \ 16)
Next

For cmb = 1 To P
tly = 0
For idx = 0 To (2 ^ P) - 1
If BitCount(idx / 5000) = cmb Then
tly = tly + 1
End If
Next

With Worksheets("Statistics").Range("B32")
.Offset(cmb - 1, 0).Value = "Title"
.Offset(cmb - 1, 1).Value = "For " & P & _
" numbers there are " & tly & _
" different groups of " & cmb & " numbers. "
End With
Next

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

--
Regards,
Tom Ogilvy






























- Show quoted text -

 

[Paul Black]

Thanks VERY much Tom.

One final thing. In the sheet named "Data" I now have a title in cell
"B3" and titles in cells "B4:G4" so the values to pick up start in
cells "B5:G?" whatever.
The line ...
Set rng = Worksheets("Data").UsedRange
.... does not accomodate the change and I have tried several other ways
of getting it to pick up the right data but to no avail.

Any Help will be greatly appreciated.
Thanks in Advance.
All the Best.
Paul

Sub Generate_Statistics()
Dim idx As Currency
Dim tly As Long
Dim cmb As Long
Dim rng As Range
Dim sh as Worksheet
Dim sh1 as Worksheet

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

set sh1 = Activesheet
Application.DisplayAlerts = False
On Error Resume Next
worksheets("Statistics").Delete
On Error goto 0
Application.Displayalerts = True
set sh = worksheets.Add( After:=Worksheets(worksheets.count))
sh.Name = "Statistics"
sh.Cells.Font.Name = "Tahoma"
sh1.activate

Set rng = Worksheets("Data").UsedRange '.Rows
P = Application.Max(rng)

For idx = 0 To 255
BC(idx) = Nibs(idx And 15) + Nibs(idx \ 16)
Next

For cmb = 1 To P
tly = 0
For idx = 0 To (2 ^ P) - 1
If BitCount(idx / 5000) = cmb Then
tly = tly + 1
End If
Next

With Worksheets("Statistics").Range("B32")
.Offset(cmb - 1, 0).Value = "Title"
.Offset(cmb - 1, 1).Value = "For " & P & _
" numbers there are " & tly & _
" different groups of " & cmb & " numbers. "
End With
Next

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

--
Regards,
Tom Ogilvy

Brilliant Tom, thanks very much.
One last thing please.
I have a sheet named "Statistics". The code below caters for what I
need except for one thing. I need it to add a sheet named "Statistics"
if it does not exist when the program is run.
So basically, if the sheet named "Statistics" exists, delete it, add a
sheet named "Statistics" and make the whole of the sheet Tahoma font.
If it does NOT already exist then add it and make the whole of the
sheet Tahoma font..
This is what I have so far :-

' Delete the existing [Statistics] sheet and ADD a new one
Worksheets("Statistics").Select
Worksheets("Statistics").Delete
Worksheets.Add.Name = "Statistics"

' Format the WHOLE [Statistics] sheet as Tahoma
Cells.Font.Name = "Tahoma"

Thanks in Advanve.
All the Best.
Paul

- Show quoted text -