Excel Rando m Selection 2

[bcoats]

OK, What I want to do is this. I have a column, call it A that has random numbers as unique identifiers and say they stop at 1000. (0-1000) I want to write a button_click method to choose say 25 of them randomly, uniquely and print out a list. Can this be done?? If the printing is a problem I could store the values in another column say Z.
This might be a real dumb question but I have never used VBA in Excel and dont even know how to access the information in the cells.

Hope to hear from you soon.

Brian

Thanks in advance for your help.

 

[segmentationfault]

NumPicks is how many items you want to take from the data. DataSize is how many samples you have, and Column represents the column where the data can be found. This sub will take NumPicks unique data points from Column and place them in the very next Column. The assumption is made that the data starts in row one, and this will generate an application error if the data is in column IV (there is no next column.)

---

Global Const NumPicks As Integer = 25
Global Const DataSize As Integer = 1000
Global Const Column As Integer = 1

Sub Picks()
Randomize
Dim i As Integer
Dim Pick As Long
Dim Picked(DataSize) As Boolean

i = 1

While i <= 25
Pick = Int(Rnd() * (DataSize) + 1)
If Picked(Pick) = False Then
Picked(Pick) = True
Cells(Pick, Column).Copy
Cells(i, Column + 1).Select
ActiveSheet.Paste
i = i + 1
End If
Wend
End Sub

 

[bcoats]

that is great, thank you. Just one question. Is there a way that I can find out how many rows there are in column 1 so that it is dynamic? I guess I should have thought of the earlier. Thanks again for your help.

 

[segmentationfault]

Give this a try.

dRow and dColumn point to the row and column of the beginning of your data, respectively. The output will appear in the next column over, beginning at the same row as the data.

The function I included may not be the most efficient algorithm for finding the bottom of a list, but I've been using it for some time and just referred to it from the Picks sub. It will find the end of a n row list in the number of digits in n, in decimal. ie the end of a 2745 row list will be found 2+7+4+5 = 18 steps. There may even be an Excel VBA function to do this, but my FindBottom function hasn't failed me yet.

---

Global Const NumPicks As Integer = 25
Global Const dRow As Long = 1
Global Const dColumn As Long = 1

Sub Picks()
Randomize
Dim i As Integer
i = 1

Dim DataSize As Long
DataSize = FindBottom(dRow, dColumn)

Dim Pick As Long
Dim Picked() As Boolean

ReDim Picked(DataSize) As Boolean

While i <= 25
Pick = Int(Rnd() * (DataSize) + 1)
If Picked(Pick) = False Then
Picked(Pick) = True
Cells(Pick, dColumn).Copy
Cells(dRow + i - 1, dColumn + 1).Select
ActiveSheet.Paste
i = i + 1
End If
Wend
End Sub

Function FindBottom(s_row As Long, s_col As Long)
Dim i As Integer
i = 1000

Dim aCell As Range
Set aCell = Cells(s_row, s_col)

While i > 1
If Cells(aCell.Row + i, aCell.Column) <> &quot;&quot; Then
Set aCell = Cells(aCell.Row + i, aCell.Column)
Else
i = i / 10
End If
Wend
While Cells(aCell.Row + i, aCell.Column) <> &quot;&quot;
Set aCell = Cells(aCell.Row + i, aCell.Column)
Wend

FindBottom = aCell.Row
End Function

 

[segmentationfault]

&quot;It will find the end of a n row list in the number of digits in n, in decimal.&quot;

Should have read:
&quot;It will find the end of a n row list in (sum of digits in n) steps.&quot;

 

[segmentationfault]

And you don't need the line:
Dim Picked() as Boolean

Just delete it.

 

[segmentationfault]

I'm sorry, I found another mistake I made. Here's the corrected code.

Global Const NumPicks As Integer = 25
Global Const dRow As Long = 1
Global Const dColumn As Long = 1

Sub Picks()
Randomize
Dim i As Integer
i = 1

Dim DataSize As Long
DataSize = FindBottom(dRow, dColumn)

Dim Pick As Long

ReDim Picked(DataSize) As Boolean

While i <= NumPicks
Pick = Int(Rnd() * (DataSize) + 1)
If Picked(Pick) = False Then
Picked(Pick) = True
Cells(Pick, dColumn).Copy
Cells(dRow + i - 1, dColumn + 1).Select
ActiveSheet.Paste
i = i + 1
End If
Wend
End Sub

Function FindBottom(s_row As Long, s_col As Long)
Dim i As Integer
i = 1000

Dim aCell As Range
Set aCell = Cells(s_row, s_col)

While i > 1
If Cells(aCell.Row + i, aCell.Column) <> &quot;&quot; Then
Set aCell = Cells(aCell.Row + i, aCell.Column)
Else
i = i / 10
End If
Wend
While Cells(aCell.Row + i, aCell.Column) <> &quot;&quot;
Set aCell = Cells(aCell.Row + i, aCell.Column)
Wend

FindBottom = aCell.Row
End Function

 

[bcoats]

that is some really cool code. One question, why do you have to redim Picked(DataSize), I don't ever see that it was dimmed in the first place. And thanks again for your help, I really like that code for findbottom. Ingenuitive.

Brian

 

[bcoats]

one other question, what command do you use to delete the data from a cell. activesheet. ???
I saw the activesheet.paste and tried activesheet.cut and activesheet.delete

Brian

 

[bcoats]

navermind i got cells(drow + i - 1, dcol + 3).value = &quot;&quot; to do it. Thank you for all you help. I hope I can answer one of your questions sometime.

Brian Coats

 

[segmentationfault]

In the first example, the size of the Boolean array was known before the code is executed (the const DataSize.) Dim will create an array, but the size must be a constant.

In the second example, the size of the sample is going to be determined by the function FindBottom. Since this value is NOT known before the code executes, you cannot Dim the array. Redim allows you to dynamically change the size of an array, which is what this situation required.

If you want to literally delete a cell, use Cells(row, column).delete shift:=xlshiftup (or xlshiftleft, etc.) If you simply want to clear it, setting the value to an empty string will usually suffice.

 

[segmentationfault]

thread707-91866 This thread demonstrates the prebuilt functions to find the bottom of a column. I had long suspected such functions existed, but quit looking for them when I had such an quick hand built one.

I'll still get use out of my FindBottom function though. My copy of it has some extra features.

 

[bcoats]

thanks a lot for your help I really appreciate it. And thanks for the heads up about the other function. that may come in handy someday but i like your function too. Real Slick.

Brian

 

[bcoats]

I was looking at your code again and was wondering why not divide by two everytime. you could start the counter at 1024 and divide by 2 each time and I think it will end up being faster. If I am wrng about this, please let me know why because I think this is interesting code and worth a look into. Thanks again for all your help.

Brian

 

[segmentationfault]

Good point.

In an over zealous analysis, the 1024/2 scheme requires consistently more division but less addition than the 1000/10 scheme, which could make a difference on some scale.

There's really no excuse for me and my 1000/10 idea, but I do recall exploring the idea of using 2 as a divisor, but for some (strange) reason discarded it. Ah well. Just to not be shown up, I cut out a while loop and present to you my whole function.

I use this on a sorted column to find the end of a section of data within the column without knowing what comes next. This is especially useful when finding data on production control reports, etc., when particular job numbers may or may not appear on the report, depending on whether they were run that month. I never know what the next data item will be, so I search for the bottom of the current one.


Function FindBottom(s_row As Long, s_col As Long, Optional LikeThis As Variant)
Dim i As Single
i = 1024

Dim aCell As Range
Set aCell = Cells(s_row, s_col)
If IsMissing(LikeThis) Then
While i >= 1
If Cells(aCell.Row + i, aCell.Column) <> &quot;&quot; Then
Set aCell = Cells(aCell.Row + i, aCell.Column)
Else
i = i / 2
End If
Wend
Else
While i > 1
If InStr(1, LikeThis, Format(Cells(aCell.Row + i, aCell.Column))) > 0 _
And Cells(aCell.Row + i, aCell.Column) <> &quot;&quot; Then
Set aCell = Cells(aCell.Row + i, aCell.Column)
Else
i = i / 2
End If
Wend
End If
FindBottom = aCell.Row
End Function