Extracting 10 random rows from one sheet, and pasting them on another.

[gb99]

Hello Everyone,

I have 3 worksheets in one workbook. I need to extract 10 random rows of information from about 193 rows in sheet 1, and post it in sheet 2 and I can't seem to find a way to make this happen correctly. Any help with this would be greatly appreciated.

Thanks

[davesexcel]

What do you mean by random rows?

[gb99]

Out of 193 rows of data, I have to create a macro that will randomly select 10 of those rows. Then the macro needs to post these 10 random rows into Sheet 2.

[jrdnoland]

Here's a function that will get you started:

Public Function RandomNumbers(Upper As Integer, _
   Optional Lower As Integer = 1, _
   Optional HowMany As Integer = 1, _
   Optional Unique As Boolean = True) As Variant
'*******************************************************
    'This Function generates random array of
    'Numbers between Lower & Upper
    'In Addition parameters can include whether
    'UNIQUE values are required
 
   'Note the Result is INCLUSIVE of the Range

    'Debug Example:
    'x = RandomNumbers(49, 1, 7)
    'For n = LBound(x) To UBound(x): Debug.Print x(n);: Next n
    'WARNING HowMany MUST be less than (Higher - Lower)
    '******************************************************

    On Error GoTo LocalError
    If HowMany > ((Upper + 1) - (Lower - 1)) Then Exit Function
    Dim x           As Integer
    Dim n           As Integer
    Dim arrNums()   As Variant
    Dim colNumbers  As New Collection
    
    ReDim arrNums(HowMany - 1)
    With colNumbers
        'First populate the collection
        For x = Lower To Upper
            .Add x
        Next x
        For x = 0 To HowMany - 1
           

 n = RandomNumber(0, colNumbers.Count + 1)
            arrNums(x) = colNumbers(n)
            If Unique Then
                colNumbers.Remove n
            End If
        Next x
    End With
    Set colNumbers = Nothing
    RandomNumbers = arrNums
Exit Function
LocalError:
    'Justin (just in case)
    RandomNumbers = ""
End Function

Call it like this:

Sub callrandom()
Dim x
x = RandomNumbers(100, 1, 10, True)
MsgBox x(1)
End Sub

The sub shows how to get the first item in this 10 item array.

Use the array indexes generated to copy those specific rows.

Use some sort of variable to find the last row in the worksheet you want to copy from and use that as the Upper limit of the random number generator. The lower limit will be the first possible row you want to copy from. 1 if there is no header, 2 if there is a one row header; etc.

Find the last row of the worksheet you want to paste the data too and paste it.