I have a spreadsheet containing several rows of data (can be over 1000 rows). First task is to randomly select 20% of the records for analysis. Of the 20% randomly selected records I need to cut and paste the entire row of data into a new tab. Is there any easy way to perform this task within excel?

re: Is there any easy way to perform this task within excel?I guess that depends on your definition of easy. ;-)

This code will create an array of random row numbers.

The size of the array will be equal to 20% of the number of rows that contain data in Sheet1 Column A - assuming every row in the range contains data. In other words, it doesn't count the data in Column A, it just determines the last row that contains data.

It then loops through the array using the Random numbers as Row numbers to determine which rows to copy to Sheet2.

Please make sure you test this in a backup copy of your workbook as macro's can not be undone.

Option Explicit Sub Random20() Randomize 'Initialize Random number seed Dim MyRows() As Integer ' Declare dynamic array. Dim numRows, percRows, nxtRow, nxtRnd, chkRnd, copyRow As Integer 'Determine Number of Rows in Sheet1 Column A numRows = Sheets(1).Range("A" & Rows.Count).End(xlUp).Row 'Get 20% of that number percRows = numRows * 0.2 'Allocate elements in Array ReDim MyRows(percRows) 'Create Random numbers and fill array For nxtRow = 1 To percRows getNew: 'Generate Random number nxtRnd = Int((numRows) * Rnd + 1) 'Loop through array, checking for Duplicates For chkRnd = 1 To nxtRow 'Get new number if Duplicate is found If MyRows(chkRnd) = nxtRnd Then GoTo getNew Next 'Add element if Random number is unique MyRows(nxtRow) = nxtRnd Next 'Loop through Array, copying rows to Sheet2 For copyRow = 1 To percRows Sheets(1).Rows(MyRows(copyRow)).EntireRow.Copy _ Destination:=Sheets(2).Cells(copyRow, 1) Next End Sub

Thank you so much! Worked perfect!!

Glad I could help.

Ask Your Question

Weekly Poll

Do you think Snapchat's rebound will continue?

Discuss in The Lounge

Poll History