Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Programming > preventing endless loops
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 140
Default preventing endless loops
Hi,
The below code manages to pick 5000 random items out of 10000 from Sheet1
columnA and display them on Sheet2. But the program locks if there are not
10000 data written in Sheet1 columnA.
Hope I need not have to enter that much data just to try it functions as it
should...
Help will be appreciated.
Regards
J_J


'----------------------------------------------
Sub Rast()
Dim RS As Long
Dim objRangeA As Range
Dim objRangeB As Range
Dim objRangeC As Range
Dim blnNotThere As Boolean

Set objRangeA = Worksheets(1).Range("A1:A10000")
Set objRangeB = Worksheets(2).Range("B1:B10000")
Set objRangeC = Worksheets(2).Range("C1:C10000")

'
If WorksheetFunction.CountA(objRangeA) < 10000 Then
MsgBox "Missing items from " & objRangeA.Parent.Name & " ", _
vbExclamation, " Maks10000"
GoTo DontCallMe
End If

Worksheets(2).Select
StartOver:

If WorksheetFunction.CountA(objRangeC) = 0 Then
objRangeC.Value = objRangeA.Value
objRangeC.Columns.AutoFit
objRangeB.ClearContents
objRangeB.ColumnWidth = objRangeC.ColumnWidth
'Range("A1").ClearContents
Range("A1").ColumnWidth = objRangeC.ColumnWidth
GoTo DontCallMe
End If

Do While blnNotThere = False
Randomize
RS = Int(Rnd * 10000 + 1)

If Not IsError(Application.Match(objRangeC(RS), objRangeC, 0)) Then
blnNotThere = True
Range("A1").Value = objRangeC(RS)
objRangeB(WorksheetFunction.CountA(objRangeB) + 1).Value =
objRangeC(RS)
objRangeC(Application.Match(objRangeC(RS), objRangeC, 0)).Delete
shift:=xlUp
End If
Loop


If WorksheetFunction.CountA(objRangeC) = 0 Then
If MsgBox("OK? ", vbQuestion + vbYesNo, _
" Randomly") = vbYes Then GoTo StartOver
End If

DontCallMe:
Set objRangeA = Nothing
Set objRangeB = Nothing
Set objRangeC = Nothing
End Sub

Private Sub CommandButton1_Click()
For z = 1 To 5001
Rast
Next z
End Sub


Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 27,285
Default preventing endless loops
Why not just put in
=rand()
in D1:D10000, (or to the last row used by column C), then sort the two
columns on the random number, then take the top N values.

--
Regards,
Tom Ogilvy


"J_J" wrote in message
...
Hi,
The below code manages to pick 5000 random items out of 10000 from Sheet1
columnA and display them on Sheet2. But the program locks if there are not
10000 data written in Sheet1 columnA.
Hope I need not have to enter that much data just to try it functions as
it
should...
Help will be appreciated.
Regards
J_J


'----------------------------------------------
Sub Rast()
Dim RS As Long
Dim objRangeA As Range
Dim objRangeB As Range
Dim objRangeC As Range
Dim blnNotThere As Boolean

Set objRangeA = Worksheets(1).Range("A1:A10000")
Set objRangeB = Worksheets(2).Range("B1:B10000")
Set objRangeC = Worksheets(2).Range("C1:C10000")

'
If WorksheetFunction.CountA(objRangeA) < 10000 Then
MsgBox "Missing items from " & objRangeA.Parent.Name & " ", _
vbExclamation, " Maks10000"
GoTo DontCallMe
End If

Worksheets(2).Select
StartOver:

If WorksheetFunction.CountA(objRangeC) = 0 Then
objRangeC.Value = objRangeA.Value
objRangeC.Columns.AutoFit
objRangeB.ClearContents
objRangeB.ColumnWidth = objRangeC.ColumnWidth
'Range("A1").ClearContents
Range("A1").ColumnWidth = objRangeC.ColumnWidth
GoTo DontCallMe
End If

Do While blnNotThere = False
Randomize
RS = Int(Rnd * 10000 + 1)

If Not IsError(Application.Match(objRangeC(RS), objRangeC, 0)) Then
blnNotThere = True
Range("A1").Value = objRangeC(RS)
objRangeB(WorksheetFunction.CountA(objRangeB) + 1).Value =
objRangeC(RS)
objRangeC(Application.Match(objRangeC(RS), objRangeC, 0)).Delete
shift:=xlUp
End If
Loop


If WorksheetFunction.CountA(objRangeC) = 0 Then
If MsgBox("OK? ", vbQuestion + vbYesNo, _
" Randomly") = vbYes Then GoTo StartOver
End If

DontCallMe:
Set objRangeA = Nothing
Set objRangeB = Nothing
Set objRangeC = Nothing
End Sub

Private Sub CommandButton1_Click()
For z = 1 To 5001
Rast
Next z
End Sub




Reply With QuoteReply With Quote
  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 140
Default preventing endless loops
Thanks Tom,
Yes I prefer that, but still wish to know how to overcome the problem in
VBA...
J_J

"Tom Ogilvy" wrote in message
...
Why not just put in
=rand()
in D1:D10000, (or to the last row used by column C), then sort the two
columns on the random number, then take the top N values.

--
Regards,
Tom Ogilvy


"J_J" wrote in message
...
Hi,
The below code manages to pick 5000 random items out of 10000 from Sheet1
columnA and display them on Sheet2. But the program locks if there are
not
10000 data written in Sheet1 columnA.
Hope I need not have to enter that much data just to try it functions as
it
should...
Help will be appreciated.
Regards
J_J


'----------------------------------------------
Sub Rast()
Dim RS As Long
Dim objRangeA As Range
Dim objRangeB As Range
Dim objRangeC As Range
Dim blnNotThere As Boolean

Set objRangeA = Worksheets(1).Range("A1:A10000")
Set objRangeB = Worksheets(2).Range("B1:B10000")
Set objRangeC = Worksheets(2).Range("C1:C10000")

'
If WorksheetFunction.CountA(objRangeA) < 10000 Then
MsgBox "Missing items from " & objRangeA.Parent.Name & " ", _
vbExclamation, " Maks10000"
GoTo DontCallMe
End If

Worksheets(2).Select
StartOver:

If WorksheetFunction.CountA(objRangeC) = 0 Then
objRangeC.Value = objRangeA.Value
objRangeC.Columns.AutoFit
objRangeB.ClearContents
objRangeB.ColumnWidth = objRangeC.ColumnWidth
'Range("A1").ClearContents
Range("A1").ColumnWidth = objRangeC.ColumnWidth
GoTo DontCallMe
End If

Do While blnNotThere = False
Randomize
RS = Int(Rnd * 10000 + 1)

If Not IsError(Application.Match(objRangeC(RS), objRangeC, 0)) Then
blnNotThere = True
Range("A1").Value = objRangeC(RS)
objRangeB(WorksheetFunction.CountA(objRangeB) + 1).Value =
objRangeC(RS)
objRangeC(Application.Match(objRangeC(RS), objRangeC, 0)).Delete
shift:=xlUp
End If
Loop


If WorksheetFunction.CountA(objRangeC) = 0 Then
If MsgBox("OK? ", vbQuestion + vbYesNo, _
" Randomly") = vbYes Then GoTo StartOver
End If

DontCallMe:
Set objRangeA = Nothing
Set objRangeB = Nothing
Set objRangeC = Nothing
End Sub

Private Sub CommandButton1_Click()
For z = 1 To 5001
Rast
Next z
End Sub






Reply With QuoteReply With Quote
  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 27,285
Default preventing endless loops
It worked fine for me with 7000 items, so your premise is flawed. I suspect
you will have problems if you have fewer items than you need to select (in
your sample, 5000).

--
Regards,
Tom Ogilvy


"J_J" wrote in message
...
Thanks Tom,
Yes I prefer that, but still wish to know how to overcome the problem in
VBA...
J_J

"Tom Ogilvy" wrote in message
...
Why not just put in
=rand()
in D1:D10000, (or to the last row used by column C), then sort the two
columns on the random number, then take the top N values.

--
Regards,
Tom Ogilvy


"J_J" wrote in message
...
Hi,
The below code manages to pick 5000 random items out of 10000 from
Sheet1
columnA and display them on Sheet2. But the program locks if there are
not
10000 data written in Sheet1 columnA.
Hope I need not have to enter that much data just to try it functions
as
it
should...
Help will be appreciated.
Regards
J_J


'----------------------------------------------
Sub Rast()
Dim RS As Long
Dim objRangeA As Range
Dim objRangeB As Range
Dim objRangeC As Range
Dim blnNotThere As Boolean

Set objRangeA = Worksheets(1).Range("A1:A10000")
Set objRangeB = Worksheets(2).Range("B1:B10000")
Set objRangeC = Worksheets(2).Range("C1:C10000")

'
If WorksheetFunction.CountA(objRangeA) < 10000 Then
MsgBox "Missing items from " & objRangeA.Parent.Name & " ", _
vbExclamation, " Maks10000"
GoTo DontCallMe
End If

Worksheets(2).Select
StartOver:

If WorksheetFunction.CountA(objRangeC) = 0 Then
objRangeC.Value = objRangeA.Value
objRangeC.Columns.AutoFit
objRangeB.ClearContents
objRangeB.ColumnWidth = objRangeC.ColumnWidth
'Range("A1").ClearContents
Range("A1").ColumnWidth = objRangeC.ColumnWidth
GoTo DontCallMe
End If

Do While blnNotThere = False
Randomize
RS = Int(Rnd * 10000 + 1)

If Not IsError(Application.Match(objRangeC(RS), objRangeC, 0))
Then
blnNotThere = True
Range("A1").Value = objRangeC(RS)
objRangeB(WorksheetFunction.CountA(objRangeB) + 1).Value =
objRangeC(RS)
objRangeC(Application.Match(objRangeC(RS), objRangeC,
0)).Delete
shift:=xlUp
End If
Loop


If WorksheetFunction.CountA(objRangeC) = 0 Then
If MsgBox("OK? ", vbQuestion + vbYesNo, _
" Randomly") = vbYes Then GoTo StartOver
End If

DontCallMe:
Set objRangeA = Nothing
Set objRangeB = Nothing
Set objRangeC = Nothing
End Sub

Private Sub CommandButton1_Click()
For z = 1 To 5001
Rast
Next z
End Sub








Reply With QuoteReply With Quote
  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 140
Default preventing endless loops
In order to prevent Excel from beeing locked because of too many items (or
maybe some blank items) Can we not add a control loop to CallMeNot process
so that if less then 10000 items are found it will skip the selection
process and jump to finish the code?.
J_J

"Tom Ogilvy" wrote in message
...
It worked fine for me with 7000 items, so your premise is flawed. I
suspect
you will have problems if you have fewer items than you need to select (in
your sample, 5000).

--
Regards,
Tom Ogilvy


"J_J" wrote in message
...
Thanks Tom,
Yes I prefer that, but still wish to know how to overcome the problem in
VBA...
J_J

"Tom Ogilvy" wrote in message
...
Why not just put in
=rand()
in D1:D10000, (or to the last row used by column C), then sort the two
columns on the random number, then take the top N values.

--
Regards,
Tom Ogilvy


"J_J" wrote in message
...
Hi,
The below code manages to pick 5000 random items out of 10000 from
Sheet1
columnA and display them on Sheet2. But the program locks if there are
not
10000 data written in Sheet1 columnA.
Hope I need not have to enter that much data just to try it functions
as
it
should...
Help will be appreciated.
Regards
J_J


'----------------------------------------------
Sub Rast()
Dim RS As Long
Dim objRangeA As Range
Dim objRangeB As Range
Dim objRangeC As Range
Dim blnNotThere As Boolean

Set objRangeA = Worksheets(1).Range("A1:A10000")
Set objRangeB = Worksheets(2).Range("B1:B10000")
Set objRangeC = Worksheets(2).Range("C1:C10000")

'
If WorksheetFunction.CountA(objRangeA) < 10000 Then
MsgBox "Missing items from " & objRangeA.Parent.Name & " ", _
vbExclamation, " Maks10000"
GoTo DontCallMe
End If

Worksheets(2).Select
StartOver:

If WorksheetFunction.CountA(objRangeC) = 0 Then
objRangeC.Value = objRangeA.Value
objRangeC.Columns.AutoFit
objRangeB.ClearContents
objRangeB.ColumnWidth = objRangeC.ColumnWidth
'Range("A1").ClearContents
Range("A1").ColumnWidth = objRangeC.ColumnWidth
GoTo DontCallMe
End If

Do While blnNotThere = False
Randomize
RS = Int(Rnd * 10000 + 1)

If Not IsError(Application.Match(objRangeC(RS), objRangeC, 0))
Then
blnNotThere = True
Range("A1").Value = objRangeC(RS)
objRangeB(WorksheetFunction.CountA(objRangeB) + 1).Value =
objRangeC(RS)
objRangeC(Application.Match(objRangeC(RS), objRangeC,
0)).Delete
shift:=xlUp
End If
Loop


If WorksheetFunction.CountA(objRangeC) = 0 Then
If MsgBox("OK? ", vbQuestion + vbYesNo, _
" Randomly") = vbYes Then GoTo StartOver
End If

DontCallMe:
Set objRangeA = Nothing
Set objRangeB = Nothing
Set objRangeC = Nothing
End Sub

Private Sub CommandButton1_Click()
For z = 1 To 5001
Rast
Next z
End Sub










Reply With QuoteReply With Quote
  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 140
Default preventing endless loops
Sorry with my mistake
It should have been
DontCallMe:

"Tom Ogilvy" wrote in message
...
It worked fine for me with 7000 items, so your premise is flawed. I
suspect
you will have problems if you have fewer items than you need to select (in
your sample, 5000).

--
Regards,
Tom Ogilvy


"J_J" wrote in message
...
Thanks Tom,
Yes I prefer that, but still wish to know how to overcome the problem in
VBA...
J_J

"Tom Ogilvy" wrote in message
...
Why not just put in
=rand()
in D1:D10000, (or to the last row used by column C), then sort the two
columns on the random number, then take the top N values.

--
Regards,
Tom Ogilvy


"J_J" wrote in message
...
Hi,
The below code manages to pick 5000 random items out of 10000 from
Sheet1
columnA and display them on Sheet2. But the program locks if there are
not
10000 data written in Sheet1 columnA.
Hope I need not have to enter that much data just to try it functions
as
it
should...
Help will be appreciated.
Regards
J_J


'----------------------------------------------
Sub Rast()
Dim RS As Long
Dim objRangeA As Range
Dim objRangeB As Range
Dim objRangeC As Range
Dim blnNotThere As Boolean

Set objRangeA = Worksheets(1).Range("A1:A10000")
Set objRangeB = Worksheets(2).Range("B1:B10000")
Set objRangeC = Worksheets(2).Range("C1:C10000")

'
If WorksheetFunction.CountA(objRangeA) < 10000 Then
MsgBox "Missing items from " & objRangeA.Parent.Name & " ", _
vbExclamation, " Maks10000"
GoTo DontCallMe
End If

Worksheets(2).Select
StartOver:

If WorksheetFunction.CountA(objRangeC) = 0 Then
objRangeC.Value = objRangeA.Value
objRangeC.Columns.AutoFit
objRangeB.ClearContents
objRangeB.ColumnWidth = objRangeC.ColumnWidth
'Range("A1").ClearContents
Range("A1").ColumnWidth = objRangeC.ColumnWidth
GoTo DontCallMe
End If

Do While blnNotThere = False
Randomize
RS = Int(Rnd * 10000 + 1)

If Not IsError(Application.Match(objRangeC(RS), objRangeC, 0))
Then
blnNotThere = True
Range("A1").Value = objRangeC(RS)
objRangeB(WorksheetFunction.CountA(objRangeB) + 1).Value =
objRangeC(RS)
objRangeC(Application.Match(objRangeC(RS), objRangeC,
0)).Delete
shift:=xlUp
End If
Loop


If WorksheetFunction.CountA(objRangeC) = 0 Then
If MsgBox("OK? ", vbQuestion + vbYesNo, _
" Randomly") = vbYes Then GoTo StartOver
End If

DontCallMe:
Set objRangeA = Nothing
Set objRangeB = Nothing
Set objRangeC = Nothing
End Sub

Private Sub CommandButton1_Click()
For z = 1 To 5001
Rast
Next z
End Sub










Reply With QuoteReply With Quote
  #7   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 27,285
Default preventing endless loops
If WorksheetFunction.CountA(objRangeA) < 10000 Then
MsgBox "Missing items from " & objRangeA.Parent.Name & " ", _
vbExclamation, " Maks10000"
GoTo DontCallMe
End If
does that in RAST. Just use similar code in the command button click
event.

--

Regards,
Tom Ogilvy




"J_J" wrote in message
...
Sorry with my mistake
It should have been
DontCallMe:

"Tom Ogilvy" wrote in message
...
It worked fine for me with 7000 items, so your premise is flawed. I
suspect
you will have problems if you have fewer items than you need to select
(in
your sample, 5000).

--
Regards,
Tom Ogilvy


"J_J" wrote in message
...
Thanks Tom,
Yes I prefer that, but still wish to know how to overcome the problem
in
VBA...
J_J

"Tom Ogilvy" wrote in message
...
Why not just put in
=rand()
in D1:D10000, (or to the last row used by column C), then sort the
two
columns on the random number, then take the top N values.

--
Regards,
Tom Ogilvy


"J_J" wrote in message
...
Hi,
The below code manages to pick 5000 random items out of 10000 from
Sheet1
columnA and display them on Sheet2. But the program locks if there
are
not
10000 data written in Sheet1 columnA.
Hope I need not have to enter that much data just to try it
functions
as
it
should...
Help will be appreciated.
Regards
J_J


'----------------------------------------------
Sub Rast()
Dim RS As Long
Dim objRangeA As Range
Dim objRangeB As Range
Dim objRangeC As Range
Dim blnNotThere As Boolean

Set objRangeA = Worksheets(1).Range("A1:A10000")
Set objRangeB = Worksheets(2).Range("B1:B10000")
Set objRangeC = Worksheets(2).Range("C1:C10000")

'
If WorksheetFunction.CountA(objRangeA) < 10000 Then
MsgBox "Missing items from " & objRangeA.Parent.Name & " ", _
vbExclamation, " Maks10000"
GoTo DontCallMe
End If

Worksheets(2).Select
StartOver:

If WorksheetFunction.CountA(objRangeC) = 0 Then
objRangeC.Value = objRangeA.Value
objRangeC.Columns.AutoFit
objRangeB.ClearContents
objRangeB.ColumnWidth = objRangeC.ColumnWidth
'Range("A1").ClearContents
Range("A1").ColumnWidth = objRangeC.ColumnWidth
GoTo DontCallMe
End If

Do While blnNotThere = False
Randomize
RS = Int(Rnd * 10000 + 1)

If Not IsError(Application.Match(objRangeC(RS), objRangeC, 0))
Then
blnNotThere = True
Range("A1").Value = objRangeC(RS)
objRangeB(WorksheetFunction.CountA(objRangeB) + 1).Value =
objRangeC(RS)
objRangeC(Application.Match(objRangeC(RS), objRangeC,
0)).Delete
shift:=xlUp
End If
Loop


If WorksheetFunction.CountA(objRangeC) = 0 Then
If MsgBox("OK? ", vbQuestion + vbYesNo, _
" Randomly") = vbYes Then GoTo StartOver
End If

DontCallMe:
Set objRangeA = Nothing
Set objRangeB = Nothing
Set objRangeC = Nothing
End Sub

Private Sub CommandButton1_Click()
For z = 1 To 5001
Rast
Next z
End Sub












Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Hybrid Mode Hybrid Mode

Posting Rules
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On

Similar Threads
Thread Thread Starter Forum Replies Last Post
Endless spreadsheet calculations Zsolt Szabó Excel Discussion (Misc queries) 0 September 22nd 09 03:22 AM
How can I make endless row, beyond IV column? Luciano New Users to Excel 2 January 23rd 06 04:08 PM
Endless loop? John Excel Programming 24 August 2nd 05 06:41 PM
Interrupting an endless loop davegb Excel Programming 3 March 17th 05 05:06 PM
Endless Loop when using ComboBox1.BoundColumn = 2 shrekut Excel Programming 2 January 12th 04 01:46 PM


All times are GMT +1. The time now is 05:59 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement