|
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 |
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 |
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 |
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 |
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 |
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 |
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 |
| All times are GMT +1. The time now is 02:17 AM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com