selecting two or more random items

[grunschlange]

Hello.

I was given assistance in coming up with the following code, which randomly selects a row from filtered data in one worksheet and pastes it in a second one:

Dim rngCol As Range
Dim lngCells As Long
Dim lngRandom As Long
Dim cel As Range
Dim i As Long
With Sheets("Office 1 Cases")
If .FilterMode Then
With .AutoFilter.Range
Set rngCol = .Columns(1) _
.Offset(1, 0) _
.Resize(.Rows.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible)
End With
Else
MsgBox "Filters not set." & vbLf & _
"Processing terminated."
Exit Sub
End If
End With

lngCells = rngCol.Cells.Count
Randomize
lngRandom = Int((lngCells * Rnd) + 1)

i = 0
For Each cel In rngCol
i = i + 1
If i = lngRandom Then

Range(cel, cel.Offset(0, 12)).Copy _
Destination:=Sheets("Office 1") _
.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0)
Exit For
End If
Next cel

How can this be modified to randomly select two or more rows of data from the worksheet and paste them in another?

Thanks.

 

[Ralajer]

Try the below. I added a loop to generate multiple random numbers and copy the corresponding rows. I changed a few other things as well some of which will improve the overall performance slightly. Change the numRandomCopies variable value to the number of rows you want to copy.

Sub copyRandomRange()

    Dim sourceWS As Worksheet
    Dim destWS As Worksheet
    Dim rngCol As Range
    Dim destLR As Long
    Dim numRandomCopies As Integer
    Dim lngRandom As Long
    Dim i As Long

    '// Change this to set how many rows to randomly copy
    [COLOR="Red"][B]numRandomCopies = 2[/B][/COLOR]
    
    Set sourceWS = Sheets("Office 1 Cases")
    Set destWS = Sheets("Office 1")
    
    If sourceWS.FilterMode = False Then
        MsgBox "Filters not set." & vbLf & "Processing terminated."
        Exit Sub
    End If
    With sourceWS.AutoFilter.Range
    Set rngCol = .Columns(1) _
                    .Offset(1, 0) _
                    .Resize(.Rows.Count - 1, 1) _
                    .SpecialCells(xlCellTypeVisible)
    End With

    destLR = destWS.Cells(Rows.Count, 1).End(xlUp).Row
    
    For i = 1 To numRandomCopies
        Randomize
        lngRandom = Int((rngCol.Cells.Count * Rnd) + 1)
        
        With sourceWS
            .Range(.Cells(lngRandom, 1), .Cells(lngRandom, 12)).Copy _
                Destination:=destWS.Cells(destLR + i, 1)
        End With
    Next i
End Sub

 

[grunschlange]

Rob,

The adjustment selects two random rows, but it is selecting rows outside of the filter that I have. I apologize...I should have posted that part as well.
The master file is made up of columns A to M and follows left to right:
Last name/First name/Middle Initial/Social Security #/Case status/Case #/Program Code/Program type/Case Class/Level/Previous manager/Next review date/Next review type.

Here is the initial filter code:

Sheets("Office 1 Cases").Select
Range("A1").Select
Columns("A:M").Select
Selection.AutoFilter

'F is the Case Class
'blank is for the next review date to signify it is an initial application
'A is for case status filtering only cases that are Active
Selection.AutoFilter Field:=9, Criteria1:="F"
Selection.AutoFilter Field:=11, Criteria1:="="
Selection.AutoFilter Field:=5, Criteria1:="A"
Application.Goto Reference:="R1C1"

Then the Dim statements begin.

Can you try your code with this to see if it could pick up two random rows within the filtered range?

Thanks.