Sully1440
06-01-2018, 10:54 AM
Hi All,
I'm having difficulty randomly selecting rows from one sheet and pasting to another. I'd like the user to identify the "Desired # of Questions =" to be copied from Cell F1.
When the user selects the macro, I want it to go through the list on sheet named "Questions" and randomly copy and paste the rows to another sheet names "Survey" until the number of questions equals the number in cell F1.
BUT, I only want to grab the rows where there is a number in Column A (and not the header).
I attached the spreadsheet as an example. Any help would be appreciated.
Thx,
Jim
Option Explicit
Option Base 1
Sub Random_Survey()
Dim LastRow As Long
Dim NbRows As Long
Dim RowList()
Dim i As Long, j As Long, k As Long
Dim RowNb As Long
Sheets("Culture Questions").Activate
LastRow = Range("A" & Rows.Count).End(xlUp).Row
NbRows = IIf(LastRow < 200, LastRow * 0.2, 20)
ReDim RowList(1 To NbRows)
k = 1
For i = 1 To NbRows
RowNb = Rnd() * LastRow
For j = 1 To k
If (RowList(j) = RowNb) Then GoTo NextStep
Next j
RowList(k) = RowNb
Rows(RowNb).Copy Destination:=Sheets("Survey").Cells(k + 2, "A")
k = k + 1
NextStep:
Next i
End Sub
I'm having difficulty randomly selecting rows from one sheet and pasting to another. I'd like the user to identify the "Desired # of Questions =" to be copied from Cell F1.
When the user selects the macro, I want it to go through the list on sheet named "Questions" and randomly copy and paste the rows to another sheet names "Survey" until the number of questions equals the number in cell F1.
BUT, I only want to grab the rows where there is a number in Column A (and not the header).
I attached the spreadsheet as an example. Any help would be appreciated.
Thx,
Jim
Option Explicit
Option Base 1
Sub Random_Survey()
Dim LastRow As Long
Dim NbRows As Long
Dim RowList()
Dim i As Long, j As Long, k As Long
Dim RowNb As Long
Sheets("Culture Questions").Activate
LastRow = Range("A" & Rows.Count).End(xlUp).Row
NbRows = IIf(LastRow < 200, LastRow * 0.2, 20)
ReDim RowList(1 To NbRows)
k = 1
For i = 1 To NbRows
RowNb = Rnd() * LastRow
For j = 1 To k
If (RowList(j) = RowNb) Then GoTo NextStep
Next j
RowList(k) = RowNb
Rows(RowNb).Copy Destination:=Sheets("Survey").Cells(k + 2, "A")
k = k + 1
NextStep:
Next i
End Sub