selecting random rows

[sherik]

Hi, VBA genuines. Please help me. I have a data (number of rows of data can vary) on sheet2, I want to select and copy specified number of rows from existing rows on sheet2 (i.e. 25 from 100 rows available) to sheet1 of the same worksheet. The problem is that I want to copy a random 25 rows out of 100 available. please help me. Thanks in advance. :D

 

[patel45]

Sub copyrnd() 
For arow = 1 To 25
   row1 = Int((100) * Rnd + 1)
   Sheets(1).Rows(row1).Copy Destination:=Sheets(2).Rows(arow)
Next
End Sub

 

[JLGWhiz]

This avoids the duplicate number returned by the standard Rnd function.

These two procedures should be copied to the standard code module1. The function should be put at the top of the code module. The second procedure calls the function and requires three long integer data type numbers in the order of sample size, lower boundry of universe and upper boundry of universe. In the myArr procedure, the numbers 25, 1 and 100 were used to get a return of 25 row numbers from rows 1 through 100 of sheet 2. You will probably need to change to 1 and 100 to the actual universe of rows that you want to sample. Run the myArr procedure to obtain results.

Code:
Function UniqueRandomNumbers(NumCount As Long, LLimit As Long, ULimit As Long) As Variant
' creates an array with NumCount unique long random numbers in the range LLimit - ULimit (including)
Dim RandColl As Collection, i As Long, varTemp() As Long
UniqueRandomNumbers = False
If NumCount < 1 Then Exit Function
If LLimit > ULimit Then Exit Function
If NumCount > (ULimit - LLimit + 1) Then Exit Function
Set RandColl = New Collection
Randomize
Do
On Error Resume Next
i = CLng(Rnd * (ULimit - LLimit) + LLimit)
RandColl.Add i, CStr(i)
On Error GoTo 0
Loop Until RandColl.Count = NumCount
ReDim varTemp(1 To NumCount)
For i = 1 To NumCount
varTemp(i) = RandColl(i)
Next i
Set RandColl = Nothing
UniqueRandomNumbers = varTemp
Erase varTemp
End Function
Code:

Code:
Sub myArr()
Dim lr As Long, rwNbr As Variant
rwNbr = UniqueRandomNumbers(25, 1, 100)
For i = 1 To 25
lr = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("Sheet2").Rows(rwNbr(i)).Copy Sheets("Sheet1").Range("A" & lr + 1)
Next
End Sub
Code:

 

[Hardyman]

Hi. I tried to use your code but got a message "Run time error 9. Subscript out of range". I tried to change Ir=sheets("Sheets2").Cells (Rows.Count,1).End(xlUp).Row. Same error message. I am new to VBA. Can anyone help, please?

 

[patel45]

can you provide a link to a sample file ?